286 lines
11 KiB
Text
286 lines
11 KiB
Text
/-
|
||
Copyright (c) 2017 Mario Carneiro. All rights reserved.
|
||
Released under Apache 2.0 license as described in the file LICENSE.
|
||
Author: Mario Carneiro
|
||
-/
|
||
|
||
prelude
|
||
import init.data.int.lemmas init.data.nat.bitwise init.data.bool.lemmas
|
||
|
||
universe u
|
||
|
||
namespace int
|
||
|
||
def div2 : ℤ → ℤ
|
||
| (of_nat n) := n.div2
|
||
| -[1+ n] := -[1+ n.div2]
|
||
|
||
def bodd : ℤ → bool
|
||
| (of_nat n) := n.bodd
|
||
| -[1+ n] := bnot (n.bodd)
|
||
|
||
@[simp] lemma bodd_zero : bodd 0 = ff := rfl
|
||
@[simp] lemma bodd_one : bodd 1 = tt := rfl
|
||
@[simp] lemma bodd_two : bodd 2 = ff := rfl
|
||
|
||
@[simp] lemma bodd_sub_nat_nat (m n : ℕ) : bodd (sub_nat_nat m n) = bxor m.bodd n.bodd :=
|
||
by apply sub_nat_nat_elim m n (λ m n i, bodd i = bxor m.bodd n.bodd);
|
||
intros i m; simp [bodd]; cases i.bodd; cases m.bodd; refl
|
||
|
||
@[simp] lemma bodd_neg_of_nat (n : ℕ) : bodd (neg_of_nat n) = n.bodd :=
|
||
by cases n; simp; refl
|
||
|
||
@[simp] lemma bodd_neg (n : ℤ) : bodd (-n) = bodd n :=
|
||
by cases n; unfold has_neg.neg; simp [int.coe_nat_eq, int.neg, bodd]
|
||
|
||
@[simp] lemma bodd_add (m n : ℤ) : bodd (m + n) = bxor (bodd m) (bodd n) :=
|
||
by cases m with m m; cases n with n n; unfold has_add.add; simp [int.add, bodd];
|
||
cases m.bodd; cases n.bodd; refl
|
||
|
||
@[simp] lemma bodd_mul (m n : ℤ) : bodd (m * n) = bodd m && bodd n :=
|
||
by cases m with m m; cases n with n n; unfold has_mul.mul; simp [int.mul, bodd];
|
||
cases m.bodd; cases n.bodd; refl
|
||
|
||
theorem bodd_add_div2 : ∀ n, cond (bodd n) 1 0 + 2 * div2 n = n
|
||
| (n : ℕ) :=
|
||
by rw [show (cond (bodd n) 1 0 : ℤ) = (cond (bodd n) 1 0 : ℕ),
|
||
by cases bodd n; refl]; exact congr_arg of_nat n.bodd_add_div2
|
||
| -[1+ n] := begin
|
||
refine eq.trans _ (congr_arg neg_succ_of_nat n.bodd_add_div2),
|
||
dsimp [bodd], cases nat.bodd n; dsimp [cond, bnot, div2, int.mul],
|
||
{ change -[1+ 2 * nat.div2 n] = _, rw zero_add },
|
||
{ rw [zero_add, add_comm], refl }
|
||
end
|
||
|
||
theorem div2_val : ∀ n, div2 n = n / 2
|
||
| (n : ℕ) := congr_arg of_nat n.div2_val
|
||
| -[1+ n] := congr_arg neg_succ_of_nat n.div2_val
|
||
|
||
def bit (b : bool) : ℤ → ℤ := cond b bit1 bit0
|
||
|
||
lemma bit0_val (n : ℤ) : bit0 n = 2 * n := (two_mul _).symm
|
||
|
||
lemma bit1_val (n : ℤ) : bit1 n = 2 * n + 1 := congr_arg (+(1:ℤ)) (bit0_val _)
|
||
|
||
lemma bit_val (b n) : bit b n = 2 * n + cond b 1 0 :=
|
||
by { cases b, apply (bit0_val n).trans (add_zero _).symm, apply bit1_val }
|
||
|
||
lemma bit_decomp (n : ℤ) : bit (bodd n) (div2 n) = n :=
|
||
(bit_val _ _).trans $ (add_comm _ _).trans $ bodd_add_div2 _
|
||
|
||
def bit_cases_on {C : ℤ → Sort u} (n) (h : ∀ b n, C (bit b n)) : C n :=
|
||
by rw -bit_decomp n; apply h
|
||
|
||
@[simp] lemma bit_zero : bit ff 0 = 0 := rfl
|
||
|
||
@[simp] lemma bit_coe_nat (b) (n : ℕ) : bit b n = nat.bit b n :=
|
||
by rw [bit_val, nat.bit_val]; cases b; refl
|
||
|
||
@[simp] lemma bit_neg_succ (b) (n : ℕ) : bit b -[1+ n] = -[1+ nat.bit (bnot b) n] :=
|
||
by rw [bit_val, nat.bit_val]; cases b; refl
|
||
|
||
@[simp] lemma bodd_bit (b n) : bodd (bit b n) = b :=
|
||
by rw bit_val; simp; cases b; cases bodd n; refl
|
||
|
||
@[simp] lemma div2_bit (b n) : div2 (bit b n) = n :=
|
||
begin
|
||
rw [bit_val, div2_val, add_comm, int.add_mul_div_left, (_ : (_/2:ℤ) = 0), zero_add],
|
||
cases b, all_goals {exact dec_trivial}
|
||
end
|
||
|
||
def test_bit : ℤ → ℕ → bool
|
||
| (m : ℕ) n := nat.test_bit m n
|
||
| -[1+ m] n := bnot (nat.test_bit m n)
|
||
|
||
@[simp] lemma test_bit_zero (b) : ∀ n, test_bit (bit b n) 0 = b
|
||
| (n : ℕ) := by rw [bit_coe_nat]; apply nat.test_bit_zero
|
||
| -[1+ n] := by rw [bit_neg_succ]; dsimp [test_bit]; rw [nat.test_bit_zero];
|
||
clear test_bit_zero; cases b; refl
|
||
|
||
@[simp] lemma test_bit_succ (m b) : ∀ n, test_bit (bit b n) (nat.succ m) = test_bit n m
|
||
| (n : ℕ) := by rw [bit_coe_nat]; apply nat.test_bit_succ
|
||
| -[1+ n] := by rw [bit_neg_succ]; dsimp [test_bit]; rw [nat.test_bit_succ]
|
||
|
||
def nat_bitwise (f : bool → bool → bool) (m n : ℕ) : ℤ :=
|
||
cond (f ff ff) -[1+ nat.bitwise (λx y, bnot (f x y)) m n] (nat.bitwise f m n)
|
||
|
||
def bitwise (f : bool → bool → bool) : ℤ → ℤ → ℤ
|
||
| (m : ℕ) (n : ℕ) := nat_bitwise f m n
|
||
| (m : ℕ) -[1+ n] := nat_bitwise (λ x y, f x (bnot y)) m n
|
||
| -[1+ m] (n : ℕ) := nat_bitwise (λ x y, f (bnot x) y) m n
|
||
| -[1+ m] -[1+ n] := nat_bitwise (λ x y, f (bnot x) (bnot y)) m n
|
||
|
||
def lnot : ℤ → ℤ
|
||
| (m : ℕ) := -[1+ m]
|
||
| -[1+ m] := m
|
||
|
||
def lor : ℤ → ℤ → ℤ
|
||
| (m : ℕ) (n : ℕ) := nat.lor m n
|
||
| (m : ℕ) -[1+ n] := -[1+ nat.ldiff n m]
|
||
| -[1+ m] (n : ℕ) := -[1+ nat.ldiff m n]
|
||
| -[1+ m] -[1+ n] := -[1+ nat.land m n]
|
||
|
||
def land : ℤ → ℤ → ℤ
|
||
| (m : ℕ) (n : ℕ) := nat.land m n
|
||
| (m : ℕ) -[1+ n] := nat.ldiff m n
|
||
| -[1+ m] (n : ℕ) := nat.ldiff n m
|
||
| -[1+ m] -[1+ n] := -[1+ nat.lor m n]
|
||
|
||
def ldiff : ℤ → ℤ → ℤ
|
||
| (m : ℕ) (n : ℕ) := nat.ldiff m n
|
||
| (m : ℕ) -[1+ n] := nat.land m n
|
||
| -[1+ m] (n : ℕ) := -[1+ nat.lor m n]
|
||
| -[1+ m] -[1+ n] := nat.ldiff n m
|
||
|
||
def lxor : ℤ → ℤ → ℤ
|
||
| (m : ℕ) (n : ℕ) := nat.lxor m n
|
||
| (m : ℕ) -[1+ n] := -[1+ nat.lxor m n]
|
||
| -[1+ m] (n : ℕ) := -[1+ nat.lxor m n]
|
||
| -[1+ m] -[1+ n] := nat.lxor m n
|
||
|
||
def shiftl : ℤ → ℤ → ℤ
|
||
| (m : ℕ) (n : ℕ) := nat.shiftl m n
|
||
| (m : ℕ) -[1+ n] := nat.shiftr m (nat.succ n)
|
||
| -[1+ m] (n : ℕ) := -[1+ nat.shiftl' tt m n]
|
||
| -[1+ m] -[1+ n] := -[1+ nat.shiftr m (nat.succ n)]
|
||
|
||
def shiftr (m n : ℤ) : ℤ := shiftl m (-n)
|
||
|
||
private meta def bitwise_tac : tactic unit := `[
|
||
apply funext, intro m,
|
||
apply funext, intro n,
|
||
cases m with m m; cases n with n n; try {refl},
|
||
all_goals {
|
||
apply congr_arg of_nat <|> apply congr_arg neg_succ_of_nat,
|
||
dsimp [nat.land, nat.ldiff, nat.lor],
|
||
try {rw [
|
||
show nat.bitwise (λ a b, a && bnot b) n m =
|
||
nat.bitwise (λ a b, b && bnot a) m n, from
|
||
congr_fun (congr_fun (@nat.bitwise_swap (λ a b, b && bnot a) rfl) n) m]},
|
||
apply congr_arg (λ f, nat.bitwise f m n),
|
||
apply funext, intro a,
|
||
apply funext, intro b,
|
||
cases a; cases b; refl
|
||
},
|
||
all_goals {unfold nat.land nat.ldiff nat.lor}
|
||
]
|
||
|
||
theorem bitwise_or : bitwise bor = lor := by bitwise_tac
|
||
theorem bitwise_and : bitwise band = land := by bitwise_tac
|
||
theorem bitwise_diff : bitwise (λ a b, a && bnot b) = ldiff := by bitwise_tac
|
||
theorem bitwise_xor : bitwise bxor = lxor := by bitwise_tac
|
||
|
||
@[simp] lemma bitwise_bit (f : bool → bool → bool) (a m b n) :
|
||
bitwise f (bit a m) (bit b n) = bit (f a b) (bitwise f m n) :=
|
||
begin
|
||
cases m with m m; cases n with n n;
|
||
repeat { rw -int.coe_nat_eq <|> rw bit_coe_nat <|> rw bit_neg_succ };
|
||
unfold bitwise nat_bitwise bnot;
|
||
[ ginduction f ff ff with h,
|
||
ginduction f ff tt with h,
|
||
ginduction f tt ff with h,
|
||
ginduction f tt tt with h ],
|
||
all_goals {
|
||
unfold cond, rw nat.bitwise_bit,
|
||
repeat { rw bit_coe_nat <|> rw bit_neg_succ <|> rw bnot_bnot } },
|
||
all_goals { unfold bnot; rw h; refl }
|
||
end
|
||
|
||
@[simp] lemma lor_bit (a m b n) : lor (bit a m) (bit b n) = bit (a || b) (lor m n) :=
|
||
by rw [-bitwise_or, bitwise_bit]
|
||
|
||
@[simp] lemma land_bit (a m b n) : land (bit a m) (bit b n) = bit (a && b) (land m n) :=
|
||
by rw [-bitwise_and, bitwise_bit]
|
||
|
||
@[simp] lemma ldiff_bit (a m b n) : ldiff (bit a m) (bit b n) = bit (a && bnot b) (ldiff m n) :=
|
||
by rw [-bitwise_diff, bitwise_bit]
|
||
|
||
@[simp] lemma lxor_bit (a m b n) : lxor (bit a m) (bit b n) = bit (bxor a b) (lxor m n) :=
|
||
by rw [-bitwise_xor, bitwise_bit]
|
||
|
||
@[simp] lemma lnot_bit (b) : ∀ n, lnot (bit b n) = bit (bnot b) (lnot n)
|
||
| (n : ℕ) := by simp [lnot]
|
||
| -[1+ n] := by simp [lnot]
|
||
|
||
@[simp] lemma test_bit_bitwise (f : bool → bool → bool) (m n k) :
|
||
test_bit (bitwise f m n) k = f (test_bit m k) (test_bit n k) :=
|
||
begin
|
||
revert m n; induction k with k IH; intros m n;
|
||
apply bit_cases_on m; intros a m';
|
||
apply bit_cases_on n; intros b n';
|
||
rw bitwise_bit,
|
||
{ simp [test_bit_zero] },
|
||
{ simp [test_bit_succ, IH] }
|
||
end
|
||
|
||
@[simp] lemma test_bit_lor (m n k) : test_bit (lor m n) k = test_bit m k || test_bit n k :=
|
||
by rw [-bitwise_or, test_bit_bitwise]
|
||
|
||
@[simp] lemma test_bit_land (m n k) : test_bit (land m n) k = test_bit m k && test_bit n k :=
|
||
by rw [-bitwise_and, test_bit_bitwise]
|
||
|
||
@[simp] lemma test_bit_ldiff (m n k) : test_bit (ldiff m n) k = test_bit m k && bnot (test_bit n k) :=
|
||
by rw [-bitwise_diff, test_bit_bitwise]
|
||
|
||
@[simp] lemma test_bit_lxor (m n k) : test_bit (lxor m n) k = bxor (test_bit m k) (test_bit n k) :=
|
||
by rw [-bitwise_xor, test_bit_bitwise]
|
||
|
||
@[simp] lemma test_bit_lnot : ∀ n k, test_bit (lnot n) k = bnot (test_bit n k)
|
||
| (n : ℕ) k := by simp [lnot, test_bit]
|
||
| -[1+ n] k := by simp [lnot, test_bit]
|
||
|
||
lemma shiftl_add : ∀ (m : ℤ) (n : ℕ) (k : ℤ), shiftl m (n + k) = shiftl (shiftl m n) k
|
||
| (m : ℕ) n (k:ℕ) := congr_arg of_nat (nat.shiftl_add _ _ _)
|
||
| -[1+ m] n (k:ℕ) := congr_arg neg_succ_of_nat (nat.shiftl'_add _ _ _ _)
|
||
| (m : ℕ) n -[1+k] := sub_nat_nat_elim n k.succ
|
||
(λ n k i, shiftl ↑m i = nat.shiftr (nat.shiftl m n) k)
|
||
(λ i n, congr_arg coe $
|
||
by rw [-nat.shiftl_sub, nat.add_sub_cancel_left]; apply nat.le_add_right)
|
||
(λ i n, congr_arg coe $
|
||
by rw [add_assoc, nat.shiftr_add, -nat.shiftl_sub, nat.sub_self]; refl)
|
||
| -[1+ m] n -[1+k] := sub_nat_nat_elim n k.succ
|
||
(λ n k i, shiftl -[1+ m] i = -[1+ nat.shiftr (nat.shiftl' tt m n) k])
|
||
(λ i n, congr_arg neg_succ_of_nat $
|
||
by rw [-nat.shiftl'_sub, nat.add_sub_cancel_left]; apply nat.le_add_right)
|
||
(λ i n, congr_arg neg_succ_of_nat $
|
||
by rw [add_assoc, nat.shiftr_add, -nat.shiftl'_sub, nat.sub_self]; refl)
|
||
|
||
lemma shiftl_sub (m : ℤ) (n : ℕ) (k : ℤ) : shiftl m (n - k) = shiftr (shiftl m n) k :=
|
||
shiftl_add _ _ _
|
||
|
||
@[simp] lemma shiftl_neg (m n : ℤ) : shiftl m (-n) = shiftr m n := rfl
|
||
@[simp] lemma shiftr_neg (m n : ℤ) : shiftr m (-n) = shiftl m n := by rw [-shiftl_neg, neg_neg]
|
||
|
||
@[simp] lemma shiftl_coe_nat (m n : ℕ) : shiftl m n = nat.shiftl m n := rfl
|
||
@[simp] lemma shiftr_coe_nat (m n : ℕ) : shiftr m n = nat.shiftr m n := by cases n; refl
|
||
|
||
@[simp] lemma shiftl_neg_succ (m n : ℕ) : shiftl -[1+ m] n = -[1+ nat.shiftl' tt m n] := rfl
|
||
@[simp] lemma shiftr_neg_succ (m n : ℕ) : shiftr -[1+ m] n = -[1+ nat.shiftr m n] := by cases n; refl
|
||
|
||
lemma shiftr_add : ∀ (m : ℤ) (n k : ℕ), shiftr m (n + k) = shiftr (shiftr m n) k
|
||
| (m : ℕ) n k := by rw [shiftr_coe_nat, shiftr_coe_nat,
|
||
-int.coe_nat_add, shiftr_coe_nat, nat.shiftr_add]
|
||
| -[1+ m] n k := by rw [shiftr_neg_succ, shiftr_neg_succ,
|
||
-int.coe_nat_add, shiftr_neg_succ, nat.shiftr_add]
|
||
|
||
lemma shiftl_eq_mul_pow : ∀ (m : ℤ) (n : ℕ), shiftl m n = m * 2 ^ n
|
||
| (m : ℕ) n := congr_arg coe (nat.shiftl_eq_mul_pow _ _)
|
||
| -[1+ m] n := @congr_arg ℕ ℤ _ _ (λi, -i) (nat.shiftl'_tt_eq_mul_pow _ _)
|
||
|
||
lemma shiftr_eq_div_pow : ∀ (m : ℤ) (n : ℕ), shiftr m n = m / 2 ^ n
|
||
| (m : ℕ) n := by rw shiftr_coe_nat; exact congr_arg coe (nat.shiftr_eq_div_pow _ _)
|
||
| -[1+ m] n := begin
|
||
rw [shiftr_neg_succ, neg_succ_of_nat_div, nat.shiftr_eq_div_pow], refl,
|
||
exact coe_nat_lt_coe_nat_of_lt (nat.pos_pow_of_pos _ dec_trivial)
|
||
end
|
||
|
||
lemma one_shiftl (n : ℕ) : shiftl 1 n = (2 ^ n : ℕ) :=
|
||
congr_arg coe (nat.one_shiftl _)
|
||
|
||
@[simp] lemma zero_shiftl : ∀ n : ℤ, shiftl 0 n = 0
|
||
| (n : ℕ) := congr_arg coe (nat.zero_shiftl _)
|
||
| -[1+ n] := congr_arg coe (nat.zero_shiftr _)
|
||
|
||
@[simp] lemma zero_shiftr (n) : shiftr 0 n = 0 := zero_shiftl _
|
||
|
||
end int
|