chore(old_library): save old library

old_library/.gitignore

@@ -0,0 +1,4 @@
+TAGS
+build.ninja
+.ninja_deps
+.ninja_log

old_library/.project

@@ -0,0 +1,44 @@
++ *.lean
+- flycheck*.lean
+- .#*.lean
+- theories/
+- algebra/
+- data/
+- logic/
+- tools/
+- smt/
+- examples/
+- bag.lean
+- bv.lean
+- complex.lean
+- countable.lean
+- encodable.lean
+- equiv.lean
+- data/finset/
+- data/fintype/
+- data/int/
+- data/rat/
+- data/real/
+- data/examples/
+- algebra/category/
+- logic/examples/
+- matrix.lean
+- squash.lean
+- stream.lean
+- old_string.lean
+- uprod.lean
+- tuple.lean
+- old_fin.lean
+- pnat.lean
+- hf.lean
+- data/vector/
+- data/set/
+- interval.lean
+- group_power.lean
+- ring_power.lean
+- group_bigops.lean
+- order_bigops.lean
+- ring_bigops.lean
+- galois_connection.lean
+- complete_lattice.lean
+- homomorphism.lean

old_library/algebra/algebra.md

@@ -0,0 +1,29 @@
+algebra
+=======
+
+Algebraic structures.
+
+* [priority](priority.lean) : priority for algebraic operations
+* [relation](relation.lean)
+* [binary](binary.lean) : binary operations
+* [order](order.lean)
+* [interval](interval.lean)
+* [lattice](lattice.lean)
+* [complete lattice](complete_lattice.lean)
+* [galois_connection](galois_connection.lean)
+* [group](group.lean)
+* [group_power](group_power.lean) : nat and int powers
+* [group_bigops](group_bigops.lean) : products and sums over lists, finsets and sets
+* [ring](ring.lean)
+* [ordered_group](ordered_group.lean)
+* [ordered_ring](ordered_ring.lean)
+* [field](field.lean)
+* [ordered_field](ordered_field.lean)
+* [module](module.lean) : modules, vector spaces, and linear maps
+* [ring_power](ring_power.lean) : power in ring structures
+* [ring_bigops](ring_bigops.lean) : products and sums in various structures
+* [order_bigops](order_bigops.lean) : min and max over finsets and finite sets
+* [bundled](bundled.lean) : bundled versions of the algebraic structures
+* [monotone](monotone.lean) : monotone maps between order structures
+* [homomorphism](homomorphism.lean) : homomorphisms between algebraic structures
+* [category](category/category.md) : category theory (outdated, see HoTT category theory folder)

old_library/algebra/binary.lean

@@ -0,0 +1,105 @@
+/-
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura, Jeremy Avigad
+
+General properties of binary operations.
+-/
+open function
+
+namespace binary
+  section
+    variable {A : Type}
+    variables (op₁ : A → A → A) (inv : A → A) (one : A)
+
+    local notation a * b := op₁ a b
+    local notation a ⁻¹  := inv a
+
+    attribute [reducible]
+    definition commutative := ∀a b, a * b = b * a
+    attribute [reducible]
+    definition associative := ∀a b c, (a * b) * c = a * (b * c)
+    attribute [reducible]
+    definition left_identity := ∀a, one * a = a
+    attribute [reducible]
+    definition right_identity := ∀a, a * one = a
+    attribute [reducible]
+    definition left_inverse := ∀a, a⁻¹ * a = one
+    attribute [reducible]
+    definition right_inverse := ∀a, a * a⁻¹ = one
+    attribute [reducible]
+    definition left_cancelative := ∀a b c, a * b = a * c → b = c
+    attribute [reducible]
+    definition right_cancelative := ∀a b c, a * b = c * b → a = c
+
+    attribute [reducible]
+    definition inv_op_cancel_left := ∀a b, a⁻¹ * (a * b) = b
+    attribute [reducible]
+    definition op_inv_cancel_left := ∀a b, a * (a⁻¹ * b) = b
+    attribute [reducible]
+    definition inv_op_cancel_right := ∀a b, a * b⁻¹ * b =  a
+    attribute [reducible]
+    definition op_inv_cancel_right := ∀a b, a * b * b⁻¹ = a
+
+    variable (op₂ : A → A → A)
+
+    local notation a + b := op₂ a b
+
+    attribute [reducible]
+    definition left_distributive := ∀a b c, a * (b + c) = a * b + a * c
+    attribute [reducible]
+    definition right_distributive := ∀a b c, (a + b) * c = a * c + b * c
+
+    attribute [reducible]
+    definition right_commutative {B : Type} (f : B → A → B) := ∀ b a₁ a₂, f (f b a₁) a₂ = f (f b a₂) a₁
+    attribute [reducible]
+    definition left_commutative {B : Type}  (f : A → B → B) := ∀ a₁ a₂ b, f a₁ (f a₂ b) = f a₂ (f a₁ b)
+  end
+
+  section
+    variable {A : Type}
+    variable {f : A → A → A}
+    variable H_comm : commutative f
+    variable H_assoc : associative f
+    local infixl `*` := f
+    include H_comm
+    theorem left_comm : left_commutative f :=
+    take a b c, calc
+      a*(b*c) = (a*b)*c  : eq.symm (H_assoc _ _ _)
+        ...   = (b*a)*c  : sorry -- by rewrite (H_comm a b)
+        ...   = b*(a*c)  : H_assoc _ _ _
+
+    theorem right_comm : right_commutative f :=
+    take a b c, calc
+      (a*b)*c = a*(b*c) : H_assoc _ _ _
+        ...   = a*(c*b) : sorry -- by rewrite (H_comm b c)
+        ...   = (a*c)*b : eq.symm (H_assoc _ _ _)
+
+    theorem comm4 (a b c d : A) : a*b*(c*d) = a*c*(b*d) :=
+    calc
+      a*b*(c*d) = a*b*c*d   : eq.symm (H_assoc _ _ _)
+        ...     = a*c*b*d   : sorry -- by rewrite (right_comm H_comm H_assoc a b c)
+        ...     = a*c*(b*d) : H_assoc _ _ _
+  end
+
+  section
+    variable {A : Type}
+    variable {f : A → A → A}
+    variable H_assoc : associative f
+    local infixl `*` := f
+    theorem assoc4helper (a b c d) : (a*b)*(c*d) = a*((b*c)*d) :=
+    calc
+      (a*b)*(c*d) = a*(b*(c*d)) : H_assoc _ _ _
+              ... = a*((b*c)*d) : sorry -- by rewrite (H_assoc b c d)
+  end
+
+  attribute [reducible]
+  definition right_commutative_comp_right
+    {A B : Type} (f : A → A → A) (g : B → A) (rcomm : right_commutative f) : right_commutative (comp_right f g) :=
+  λ a b₁ b₂, rcomm _ _ _
+
+  attribute [reducible]
+  definition left_commutative_compose_left
+    {A B : Type} (f : A → A → A) (g : B → A) (lcomm : left_commutative f) : left_commutative (comp_left f g) :=
+  λ a b₁ b₂, lcomm _ _ _
+end binary

old_library/algebra/bundled.lean

@@ -0,0 +1,68 @@
+/-
+Copyright (c) 2015 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad
+
+Bundled structures
+-/
+import algebra.group
+
+structure Semigroup :=
+(carrier : Type) (struct : semigroup carrier)
+
+attribute Semigroup.struct [instance]
+
+structure CommSemigroup :=
+(carrier : Type) (struct : comm_semigroup carrier)
+
+attribute CommSemigroup.struct [instance]
+
+structure Monoid :=
+(carrier : Type) (struct : monoid carrier)
+
+attribute Monoid.struct [instance]
+
+structure CommMonoid :=
+(carrier : Type) (struct : comm_monoid carrier)
+
+attribute CommMonoid.struct [instance]
+
+structure Group :=
+(carrier : Type) (struct : group carrier)
+
+attribute Group.struct [instance]
+
+structure CommGroup :=
+(carrier : Type) (struct : comm_group carrier)
+
+attribute CommGroup.struct [instance]
+
+structure AddSemigroup :=
+(carrier : Type) (struct : add_semigroup carrier)
+
+attribute AddSemigroup.struct [instance]
+
+structure AddCommSemigroup :=
+(carrier : Type) (struct : add_comm_semigroup carrier)
+
+attribute AddCommSemigroup.struct [instance]
+
+structure AddMonoid :=
+(carrier : Type) (struct : add_monoid carrier)
+
+attribute AddMonoid.struct [instance]
+
+structure AddCommMonoid :=
+(carrier : Type) (struct : add_comm_monoid carrier)
+
+attribute AddCommMonoid.struct [instance]
+
+structure AddGroup :=
+(carrier : Type) (struct : add_group carrier)
+
+attribute AddGroup.struct [instance]
+
+structure AddCommGroup :=
+(carrier : Type) (struct : add_comm_group carrier)
+
+attribute AddCommGroup.struct [instance]

old_library/algebra/category/adjoint.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Floris van Doorn
+-/
+
+import .constructions
+
+open eq eq.ops category functor natural_transformation category.ops prod category.product
+
+namespace adjoint
+
+  -- definition Hom (C : Category) : Cᵒᵖ ×c C ⇒ type :=
+  -- functor.mk (λ a, hom (pr1 a) (pr2 a))
+  --            (λ a b f h, sorry)
+  --            (λ a, sorry)
+  --            (λ a b c g f, sorry)
+
+end adjoint

old_library/algebra/category/basic.lean

@@ -0,0 +1,63 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Floris van Doorn
+-/
+open eq eq.ops
+
+structure category [class] (ob : Type) : Type :=
+  (hom : ob → ob → Type)
+  (comp : Π⦃a b c : ob⦄, hom b c → hom a b → hom a c)
+  (ID : Π (a : ob), hom a a)
+  (assoc : Π ⦃a b c d : ob⦄ (h : hom c d) (g : hom b c) (f : hom a b),
+     comp h (comp g f) = comp (comp h g) f)
+  (id_left : Π ⦃a b : ob⦄ (f : hom a b), comp !ID f = f)
+  (id_right : Π ⦃a b : ob⦄ (f : hom a b), comp f !ID = f)
+
+attribute category [multiple_instances]
+
+namespace category
+  variables {ob : Type} [C : category ob]
+  variables {a b c d : ob}
+  include C
+
+  definition compose := @comp ob _
+
+  attribute [reducible]
+  definition id {a : ob} : hom a a := ID a
+
+  infixr `∘` := comp
+  infixl `⟶`:25 := hom -- input ⟶ using \--> (this is a different arrow than \-> (→))
+
+  variables {h : hom c d} {g : hom b c} {f : hom a b} {i : hom a a}
+
+  --the following is the only theorem for which "include C" is necessary if C is a variable (why?)
+  theorem id_compose (a : ob) : (ID a) ∘ id = id := !id_left
+
+  theorem left_id_unique (H : Π{b} {f : hom b a}, i ∘ f = f) : i = id :=
+  calc i = i ∘ id : id_right
+     ... = id     : H
+
+  theorem right_id_unique (H : Π{b} {f : hom a b}, f ∘ i = f) : i = id :=
+  calc i = id ∘ i : id_left
+     ... = id     : H
+end category
+
+inductive Category : Type := mk : Π (ob : Type), category ob → Category
+
+namespace category
+  definition Mk {ob} (C) : Category := Category.mk ob C
+  definition MK (a b c d e f g) : Category := Category.mk a (category.mk b c d e f g)
+
+  -- definition objects [coercion] [reducible] (C : Category) : Type
+  --   := Category.rec (fun c s, c) C
+
+  -- definition category_instance [instance] [coercion] (C : Category) : category (objects C)
+  -- := Category.rec (fun c s, s) C
+
+end category
+
+open category
+
+theorem Category.equal (C : Category) : Category.mk C C = C :=
+Category.rec (λ ob c, rfl) C

old_library/algebra/category/category.md

@@ -0,0 +1,18 @@
+algebra.category
+================
+
+Everything in this folder is outdated. See HoTT category folder for a up-to-date version.
+
+Algebraic structures.
+
+* [basic](basic.lean) : definition of fully and partially bundled categories
+* [morphism](morphism.lean) : isos, retracts, sections, monos, epis
+* [functor](functor.lean) : functors, category of (smaller) categories
+* [natural_transformation](natural_transformation.lean)
+* [constructions](constructions.lean) : constructions of basic examples and constructions of categories: opposite, type, discrete, product, functor, slice and arrow categories
+
+The following files hardly have any content so far.
+
+* [limit](limit.lean) : limits and colimits
+* [adjoint](adjoint.lean) : adjoint functors
+* [yoneda](yoneda.lean) : Yoneda embedding and Yoneda lemma

old_library/algebra/category/constructions.lean

@@ -0,0 +1,386 @@
+-- Copyright (c) 2014 Floris van Doorn. All rights reserved.
+-- Released under Apache 2.0 license as described in the file LICENSE.
+-- Author: Floris van Doorn
+
+-- This file contains basic constructions on categories, including common categories
+
+
+import .natural_transformation
+import data.unit data.sigma data.prod data.empty data.bool
+
+open eq eq.ops prod
+namespace category
+  namespace opposite
+  section
+  attribute [reducible]
+  definition opposite {ob : Type} (C : category ob) : category ob :=
+  mk (λa b, hom b a)
+     (λ a b c f g, g ∘ f)
+     (λ a, id)
+     (λ a b c d f g h, symm !assoc)
+     (λ a b f, !id_right)
+     (λ a b f, !id_left)
+
+  attribute [reducible]
+  definition Opposite (C : Category) : Category := Mk (opposite C)
+  --direct construction:
+  -- MK C
+  --    (λa b, hom b a)
+  --    (λ a b c f g, g ∘ f)
+  --    (λ a, id)
+  --    (λ a b c d f g h, symm !assoc)
+  --    (λ a b f, !id_right)
+  --    (λ a b f, !id_left)
+
+  infixr `∘op`:60 := @comp _ (opposite _) _ _ _
+
+  variables {C : Category} {a b c : C}
+
+  theorem compose_op {f : hom a b} {g : hom b c} : f ∘op g = g ∘ f := rfl
+
+  theorem op_op' {ob : Type} (C : category ob) : opposite (opposite C) = C :=
+  category.rec (λ hom comp id assoc idl idr, refl (mk _ _ _ _ _ _)) C
+
+  definition op_op : Opposite (Opposite C) = C :=
+  (@congr_arg _ _ (@opposite C (@opposite C C)) _ (Category.mk C) (op_op' C)) ⬝ !Category.equal
+
+  end
+  end opposite
+
+  attribute [reducible]
+  definition type_category : category Type :=
+  mk (λa b, a → b)
+     (λ a b c, function.comp)
+     (λ a, _root_.id)
+     (λ a b c d h g f, symm (function.comp.assoc h g f))
+     (λ a b f, function.comp.left_id f)
+     (λ a b f, function.comp.right_id f)
+
+  attribute [reducible]
+  definition Type_category : Category := Mk type_category
+
+  section
+  open decidable unit empty
+  variables {A : Type} [H : decidable_eq A]
+  include H
+  attribute [reducible]
+  definition set_hom (a b : A) := decidable.rec_on (H a b) (λh, unit) (λh, empty)
+  attribute [instance]
+  theorem set_hom_subsingleton (a b : A) : subsingleton (set_hom a b) := rec_subsingleton
+  attribute [reducible]
+  definition set_compose {a b c : A} (g : set_hom b c) (f : set_hom a b) : set_hom a c :=
+  decidable.rec_on
+    (H b c)
+    (λ Hbc g, decidable.rec_on
+      (H a b)
+      (λ Hab f, rec_on_true (trans Hab Hbc) ⋆)
+      (λh f, empty.rec _ f) f)
+    (λh (g : empty), empty.rec _ g) g
+  omit H
+  definition discrete_category (A : Type) [H : decidable_eq A] : category A :=
+  mk (λa b, set_hom a b)
+     (λ a b c g f, set_compose g f)
+     (λ a, decidable.rec_on_true rfl ⋆)
+     (λ a b c d h g f, @subsingleton.elim (set_hom a d) _ _ _)
+     (λ a b f, @subsingleton.elim (set_hom a b) _ _ _)
+     (λ a b f, @subsingleton.elim (set_hom a b) _ _ _)
+  local attribute discrete_category [reducible]
+  definition Discrete_category (A : Type) [H : decidable_eq A] := Mk (discrete_category A)
+    section
+    local attribute discrete_category [instance]
+    include H
+    theorem discrete_category.endomorphism {a b : A} (f : a ⟶ b) : a = b :=
+    decidable.rec_on (H a b) (λh f, h) (λh f, empty.rec _ f) f
+
+    theorem discrete_category.discrete {a b : A} (f : a ⟶ b)
+      : eq.rec_on (discrete_category.endomorphism f) f = (ID b) :=
+    @subsingleton.elim _ !set_hom_subsingleton _ _
+
+    definition discrete_category.rec_on {P : Πa b, a ⟶ b → Type} {a b : A} (f : a ⟶ b)
+        (H : ∀a, P a a id) : P a b f :=
+    cast (dcongr_arg3 P rfl (discrete_category.endomorphism f)⁻¹
+                            (@subsingleton.elim _ !set_hom_subsingleton _ _))⁻¹ (H a)
+    end
+  end
+  section
+  open unit bool
+  definition category_one := discrete_category unit
+  definition Category_one := Mk category_one
+  definition category_two := discrete_category bool
+  definition Category_two := Mk category_two
+  end
+
+  namespace product
+    section
+    open prod
+    attribute [reducible]
+    definition prod_category {obC obD : Type} (C : category obC) (D : category obD)
+        : category (obC × obD) :=
+    mk (λa b, hom (pr1 a) (pr1 b) × hom (pr2 a) (pr2 b))
+       (λ a b c g f, (pr1 g ∘ pr1 f , pr2 g ∘ pr2 f) )
+       (λ a, (id,id))
+       (λ a b c d h g f, pair_eq !assoc    !assoc   )
+       (λ a b f,         prod.eq !id_left  !id_left )
+       (λ a b f,         prod.eq !id_right !id_right)
+
+    attribute [reducible]
+    definition Prod_category (C D : Category) : Category := Mk (prod_category C D)
+    end
+  end product
+
+  namespace ops
+    notation `type`:max := Type_category
+    postfix `ᵒᵖ`:max := opposite.Opposite
+    infixr `×c`:30 := product.Prod_category
+    attribute type_category [instance]
+    attribute category_one [instance]
+    attribute category_two [instance]
+    attribute product.prod_category [instance]
+  end ops
+
+  open ops
+  namespace opposite
+  section
+  open functor
+  attribute [reducible]
+  definition opposite_functor {C D : Category} (F : C ⇒ D) : Cᵒᵖ ⇒ Dᵒᵖ :=
+  @functor.mk (Cᵒᵖ) (Dᵒᵖ)
+              (λ a, F a)
+              (λ a b f, F f)
+              (λ a, respect_id F a)
+              (λ a b c g f, by apply @respect_comp C D)
+  end
+  end opposite
+
+  namespace product
+  section
+  open ops functor
+  attribute [reducible]
+  definition prod_functor {C C' D D' : Category} (F : C ⇒ D) (G : C' ⇒ D')
+      : C ×c C' ⇒ D ×c D' :=
+  functor.mk (λ a, pair (F (pr1 a)) (G (pr2 a)))
+             (λ a b f, pair (F (pr1 f)) (G (pr2 f)))
+             (λ a, pair_eq !respect_id !respect_id)
+             (λ a b c g f, pair_eq !respect_comp !respect_comp)
+  end
+  end product
+
+  namespace ops
+  infixr `×f`:30 := product.prod_functor
+  infixr `ᵒᵖᶠ`:max := opposite.opposite_functor
+  end ops
+
+  section functor_category
+  variables (C D : Category)
+  definition functor_category : category (functor C D) :=
+  mk (λa b, natural_transformation a b)
+     (λ a b c g f, natural_transformation.compose g f)
+     (λ a, natural_transformation.id)
+     (λ a b c d h g f, !natural_transformation.assoc)
+     (λ a b f, !natural_transformation.id_left)
+     (λ a b f, !natural_transformation.id_right)
+  end functor_category
+
+  namespace slice
+  open sigma function
+  variables {ob : Type} {C : category ob} {c : ob}
+  protected definition slice_obs (C : category ob) (c : ob) := Σ(b : ob), hom b c
+  variables {a b : slice.slice_obs C c}
+  protected definition to_ob  (a : slice.slice_obs C c) : ob              := sigma.pr1 a
+  protected definition to_ob_def (a : slice.slice_obs C c) : slice.to_ob a = sigma.pr1 a := rfl
+  protected definition ob_hom (a : slice.slice_obs C c) : hom (slice.to_ob a) c := sigma.pr2 a
+  -- protected theorem slice_obs_equal (H₁ : to_ob a = to_ob b)
+  --     (H₂ : eq.drec_on H₁ (ob_hom a) = ob_hom b) : a = b :=
+  -- sigma.equal H₁ H₂
+
+
+  protected definition slice_hom (a b : slice.slice_obs C c) : Type :=
+  Σ(g : hom (slice.to_ob a) (slice.to_ob b)), slice.ob_hom b ∘ g = slice.ob_hom a
+
+  protected definition hom_hom  (f : slice.slice_hom a b) : hom (slice.to_ob a) (slice.to_ob b)                := sigma.pr1 f
+  protected definition commute (f : slice.slice_hom a b) : slice.ob_hom b ∘ (slice.hom_hom f) = slice.ob_hom a := sigma.pr2 f
+  -- protected theorem slice_hom_equal (f g : slice_hom a b) (H : hom_hom f = hom_hom g) : f = g :=
+  -- sigma.equal H !proof_irrel
+
+  definition slice_category (C : category ob) (c : ob) : category (slice.slice_obs C c) :=
+  mk (λa b, slice.slice_hom a b)
+     (λ a b c g f, sigma.mk (slice.hom_hom g ∘ slice.hom_hom f)
+       (show slice.ob_hom c ∘ (slice.hom_hom g ∘ slice.hom_hom f) = slice.ob_hom a,
+         proof
+         calc
+           slice.ob_hom c ∘ (slice.hom_hom g ∘ slice.hom_hom f) = (slice.ob_hom c ∘ slice.hom_hom g) ∘ slice.hom_hom f : !assoc
+             ... = slice.ob_hom b ∘ slice.hom_hom f : {slice.commute g}
+             ... = slice.ob_hom a : {slice.commute f}
+         qed))
+     (λ a, sigma.mk id !id_right)
+     (λ a b c d h g f, dpair_eq !assoc    !proof_irrel)
+     (λ a b f,         sigma.eq !id_left  !proof_irrel)
+     (λ a b f,         sigma.eq !id_right !proof_irrel)
+  -- We use !proof_irrel instead of rfl, to give the unifier an easier time
+
+  -- definition slice_category {ob : Type} (C : category ob) (c : ob) : category (Σ(b : ob), hom b c)
+  -- :=
+  -- mk (λa b, Σ(g : hom (dpr1 a) (dpr1 b)), dpr2 b ∘ g = dpr2 a)
+  --    (λ a b c g f, dpair (dpr1 g ∘ dpr1 f)
+  --      (show dpr2 c ∘ (dpr1 g ∘ dpr1 f) = dpr2 a,
+  --        proof
+  --        calc
+  --          dpr2 c ∘ (dpr1 g ∘ dpr1 f) = (dpr2 c ∘ dpr1 g) ∘ dpr1 f : !assoc
+  --            ... = dpr2 b ∘ dpr1 f : {dpr2 g}
+  --            ... = dpr2 a : {dpr2 f}
+  --        qed))
+  --    (λ a, dpair id !id_right)
+  --    (λ a b c d h g f, dpair_eq    !assoc    !proof_irrel)
+  --    (λ a b f,         sigma.equal !id_left  !proof_irrel)
+  --    (λ a b f,         sigma.equal !id_right !proof_irrel)
+  -- We use !proof_irrel instead of rfl, to give the unifier an easier time
+
+  attribute [reducible]
+  definition Slice_category (C : Category) (c : C) := Mk (slice_category C c)
+  open category.ops
+  attribute slice_category [instance]
+  variables {D : Category}
+  definition forgetful (x : D) : (Slice_category D x) ⇒ D :=
+  functor.mk (λ a, slice.to_ob a)
+             (λ a b f, slice.hom_hom f)
+             (λ a, rfl)
+             (λ a b c g f, rfl)
+
+  definition postcomposition_functor {x y : D} (h : x ⟶ y)
+      : Slice_category D x ⇒ Slice_category D y :=
+  functor.mk
+       (λ a, sigma.mk (slice.to_ob a) (h ∘ slice.ob_hom a))
+       (λ a b f,
+         ⟨slice.hom_hom f,
+          calc
+            (h ∘ slice.ob_hom b) ∘ slice.hom_hom f = h ∘ (slice.ob_hom b ∘ slice.hom_hom f) : by rewrite assoc
+                                   ... = h ∘ slice.ob_hom a               : by rewrite slice.commute⟩)
+       (λ a, rfl)
+       (λ a b c g f, dpair_eq rfl !proof_irrel)
+
+  -- -- in the following comment I tried to have (A = B) in the type of a == b, but that doesn't solve the problems
+  -- definition heq2 {A B : Type} (H : A = B) (a : A) (b : B) := a == b
+  -- definition heq2.intro {A B : Type} {a : A} {b : B} (H : a == b) : heq2 (heq.type_eq H) a b := H
+  -- definition heq2.elim {A B : Type} {a : A} {b : B} (H : A = B) (H2 : heq2 H a b) : a == b := H2
+  -- definition heq2.proof_irrel {A B : Prop} (a : A) (b : B) (H : A = B) : heq2 H a b :=
+  -- hproof_irrel H a b
+  -- theorem functor.mk_eq2 {C D : Category} {obF obG : C → D} {homF homG idF idG compF compG}
+  --    (Hob : ∀x, obF x = obG x)
+  --    (Hmor : ∀(a b : C) (f : a ⟶ b), heq2 (congr_arg (λ x, x a ⟶ x b) (funext Hob)) (homF a b f) (homG a b f))
+  --      : functor.mk obF homF idF compF = functor.mk obG homG idG compG :=
+  -- hddcongr_arg4 functor.mk
+  --             (funext Hob)
+  --             (hfunext (λ a, hfunext (λ b, hfunext (λ f, !Hmor))))
+  --             !proof_irrel
+  --             !proof_irrel
+
+--  set_option pp.implicit true
+--  set_option pp.coercions true
+
+  -- definition slice_functor : D ⇒ Category_of_categories :=
+  -- functor.mk (λ a, Category.mk (slice_obs D a) (slice_category D a))
+  --            (λ a b f, postcomposition_functor f)
+  --            (λ a, functor.mk_heq
+  --              (λx, sigma.equal rfl !id_left)
+  --              (λb c f, sigma.hequal sorry !heq.refl (hproof_irrel sorry _ _)))
+  --            (λ a b c g f, functor.mk_heq
+  --                    (λx, sigma.equal (sorry ⬝ refl (dpr1 x)) sorry)
+  --                    (λb c f, sorry))
+
+  --the error message generated here is really confusing: the type of the above refl should be
+  -- "@dpr1 D (λ (a_1 : D), a_1 ⟶ a) x = @dpr1 D (λ (a_1 : D), a_1 ⟶ c) x", but the second dpr1 is not even well-typed
+
+  end slice
+
+  -- section coslice
+  -- open sigma
+
+  -- definition coslice {ob : Type} (C : category ob) (c : ob) : category (Σ(b : ob), hom c b) :=
+  -- mk (λa b, Σ(g : hom (dpr1 a) (dpr1 b)), g ∘ dpr2 a = dpr2 b)
+  --    (λ a b c g f, dpair (dpr1 g ∘ dpr1 f)
+  --      (show (dpr1 g ∘ dpr1 f) ∘ dpr2 a = dpr2 c,
+  --        proof
+  --        calc
+  --          (dpr1 g ∘ dpr1 f) ∘ dpr2 a = dpr1 g ∘ (dpr1 f ∘ dpr2 a): symm !assoc
+  --            ... = dpr1 g ∘ dpr2 b : {dpr2 f}
+  --            ... = dpr2 c : {dpr2 g}
+  --        qed))
+  --    (λ a, dpair id !id_left)
+  --    (λ a b c d h g f, dpair_eq    !assoc    !proof_irrel)
+  --    (λ a b f,         sigma.equal !id_left  !proof_irrel)
+  --    (λ a b f,         sigma.equal !id_right !proof_irrel)
+
+  -- -- theorem slice_coslice_opp {ob : Type} (C : category ob) (c : ob) :
+  -- --     coslice C c = opposite (slice (opposite C) c) :=
+  -- -- sorry
+  -- end coslice
+
+  section arrow
+  open sigma eq.ops
+  -- theorem concat_commutative_squares {ob : Type} {C : category ob} {a1 a2 a3 b1 b2 b3 : ob}
+  --     {f1 : a1 => b1} {f2 : a2 => b2} {f3 : a3 => b3} {g2 : a2 => a3} {g1 : a1 => a2}
+  --     {h2 : b2 => b3} {h1 : b1 => b2} (H1 : f2 ∘ g1 = h1 ∘ f1) (H2 : f3 ∘ g2 = h2 ∘ f2)
+  --       : f3 ∘ (g2 ∘ g1) = (h2 ∘ h1) ∘ f1 :=
+  -- calc
+  --   f3 ∘ (g2 ∘ g1) = (f3 ∘ g2) ∘ g1 : assoc
+  --     ... = (h2 ∘ f2) ∘ g1 : {H2}
+  --     ... = h2 ∘ (f2 ∘ g1) : symm assoc
+  --     ... = h2 ∘ (h1 ∘ f1) : {H1}
+  --     ... = (h2 ∘ h1) ∘ f1 : assoc
+
+  -- definition arrow {ob : Type} (C : category ob) : category (Σ(a b : ob), hom a b) :=
+  -- mk (λa b, Σ(g : hom (dpr1 a) (dpr1 b)) (h : hom (dpr2' a) (dpr2' b)),
+  --      dpr3 b ∘ g = h ∘ dpr3 a)
+  --    (λ a b c g f, dpair (dpr1 g ∘ dpr1 f) (dpair (dpr2' g ∘ dpr2' f) (concat_commutative_squares (dpr3 f) (dpr3 g))))
+  --    (λ a, dpair id (dpair id (id_right ⬝ (symm id_left))))
+  --    (λ a b c d h g f, dtrip_eq2   assoc    assoc    !proof_irrel)
+  --    (λ a b f,         trip.equal2 id_left  id_left  !proof_irrel)
+  --    (λ a b f,         trip.equal2 id_right id_right !proof_irrel)
+
+  -- make these definitions private?
+  variables {ob : Type} {C : category ob}
+  protected definition arrow_obs (ob : Type) (C : category ob) := Σ(a b : ob), hom a b
+  variables {a b : category.arrow_obs ob C}
+  protected definition src    (a : category.arrow_obs ob C) : ob                  := sigma.pr1 a
+  protected definition dst    (a : category.arrow_obs ob C) : ob                  := sigma.pr2' a
+  protected definition to_hom (a : category.arrow_obs ob C) : hom (category.src a) (category.dst a) := sigma.pr3 a
+
+  protected definition arrow_hom (a b : category.arrow_obs ob C) : Type :=
+  Σ (g : hom (category.src a) (category.src b)) (h : hom (category.dst a) (category.dst b)),
+    category.to_hom b ∘ g = h ∘ category.to_hom a
+
+  protected definition hom_src (m : category.arrow_hom a b) : hom (category.src a) (category.src b) := sigma.pr1 m
+  protected definition hom_dst (m : category.arrow_hom a b) : hom (category.dst a) (category.dst b) := sigma.pr2' m
+  protected definition commute (m : category.arrow_hom a b) :
+     category.to_hom b ∘ (category.hom_src m) = (category.hom_dst m) ∘ category.to_hom a
+  := sigma.pr3 m
+
+  definition arrow (ob : Type) (C : category ob) : category (category.arrow_obs ob C) :=
+  mk (λa b, category.arrow_hom a b)
+     (λ a b c g f, sigma.mk (category.hom_src g ∘ category.hom_src f) (sigma.mk (category.hom_dst g ∘ category.hom_dst f)
+        (show category.to_hom c ∘ (category.hom_src g ∘ category.hom_src f) = (category.hom_dst g ∘ category.hom_dst f) ∘ category.to_hom a,
+         proof
+         calc
+         category.to_hom c ∘ (category.hom_src g ∘ category.hom_src f) = (category.to_hom c ∘ category.hom_src g) ∘ category.hom_src f : by rewrite assoc
+           ... = (category.hom_dst g ∘ category.to_hom b) ∘ category.hom_src f                     : by rewrite category.commute
+           ... = category.hom_dst g ∘ (category.to_hom b ∘ category.hom_src f)                     : by rewrite assoc
+           ... = category.hom_dst g ∘ (category.hom_dst f ∘ category.to_hom a)                     : by rewrite category.commute
+           ... = (category.hom_dst g ∘ category.hom_dst f) ∘ category.to_hom a                     : by rewrite assoc
+         qed)
+       ))
+     (λ a, sigma.mk id (sigma.mk id (!id_right ⬝ (symm !id_left))))
+     (λ a b c d h g f, ndtrip_eq    !assoc    !assoc    !proof_irrel)
+     (λ a b f,         ndtrip_equal !id_left  !id_left  !proof_irrel)
+     (λ a b f,         ndtrip_equal !id_right !id_right !proof_irrel)
+
+  end arrow
+
+end category
+
+  -- definition foo : category (sorry) :=
+  -- mk (λa b, sorry)
+  --    (λ a b c g f, sorry)
+  --    (λ a, sorry)
+  --    (λ a b c d h g f, sorry)
+  --    (λ a b f, sorry)
+  --    (λ a b f, sorry)

old_library/algebra/category/default.lean

@@ -0,0 +1,7 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Floris van Doorn
+-/
+
+import .morphism .constructions

old_library/algebra/category/functor.lean

@@ -0,0 +1,123 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Floris van Doorn
+-/
+import .basic
+import logic.cast
+open function
+open category eq eq.ops heq
+
+structure functor (C D : Category) : Type :=
+  (object : C → D)
+  (morphism : Π⦃a b : C⦄, hom a b → hom (object a) (object b))
+  (respect_id : Π (a : C), morphism (ID a) = ID (object a))
+  (respect_comp : Π ⦃a b c : C⦄ (g : hom b c) (f : hom a b),
+      morphism (g ∘ f) = morphism g ∘ morphism f)
+
+infixl `⇒`:25 := functor
+
+namespace functor
+  -- attribute object [coercion]
+  -- attribute morphism [coercion]
+  attribute respect_id [irreducible]
+  attribute respect_comp [irreducible]
+
+  variables {A B C D : Category}
+
+  attribute [reducible]
+  protected definition compose (G : functor B C) (F : functor A B) : functor A C :=
+  functor.mk
+    (λx, G (F x))
+    (λ a b f, G (F f))
+    (λ a, proof calc
+      G (F (ID a)) = G id : {respect_id F a}
+      --not giving the braces explicitly makes the elaborator compute a couple more seconds
+               ... = id   : respect_id G (F a) qed)
+    (λ a b c g f, proof calc
+      G (F (g ∘ f)) = G (F g ∘ F f)     : respect_comp F g f
+                ... = G (F g) ∘ G (F f) : respect_comp G (F g) (F f) qed)
+
+  infixr `∘f`:60 := functor.compose
+
+  protected theorem assoc (H : functor C D) (G : functor B C) (F : functor A B) :
+      H ∘f (G ∘f F) = (H ∘f G) ∘f F :=
+  rfl
+
+  attribute [reducible]
+  protected definition id {C : Category} : functor C C :=
+  mk (λa, a) (λ a b f, f) (λ a, rfl) (λ a b c f g, rfl)
+  attribute [reducible]
+  protected definition ID (C : Category) : functor C C := @functor.id C
+
+  protected theorem id_left  (F : functor C D) : (@functor.id D) ∘f F = F :=
+  functor.rec (λ obF homF idF compF, dcongr_arg4 mk rfl rfl !proof_irrel !proof_irrel) F
+  protected theorem id_right (F : functor C D) : F ∘f (@functor.id C) = F :=
+  functor.rec (λ obF homF idF compF, dcongr_arg4 mk rfl rfl !proof_irrel !proof_irrel) F
+
+end functor
+
+namespace category
+  open functor
+  attribute [reducible]
+  definition category_of_categories : category Category :=
+  mk (λ a b, functor a b)
+     (λ a b c g f, functor.compose g f)
+     (λ a, functor.id)
+     (λ a b c d h g f, !functor.assoc)
+     (λ a b f, !functor.id_left)
+     (λ a b f, !functor.id_right)
+
+  attribute [reducible]
+  definition Category_of_categories := Mk category_of_categories
+
+  namespace ops
+    notation `Cat`:max := Category_of_categories
+    attribute category_of_categories [instance]
+  end ops
+end category
+
+namespace functor
+
+   variables {C D : Category}
+
+  theorem mk_heq {obF obG : C → D} {homF homG idF idG compF compG} (Hob : ∀x, obF x = obG x)
+     (Hmor : ∀(a b : C) (f : a ⟶ b), homF a b f == homG a b f)
+       : mk obF homF idF compF = mk obG homG idG compG :=
+  hddcongr_arg4 mk
+              (funext Hob)
+              (hfunext (λ a, hfunext (λ b, hfunext (λ f, !Hmor))))
+              !proof_irrel
+              !proof_irrel
+
+  protected theorem hequal {F G : C ⇒ D} : Π (Hob : ∀x, F x = G x)
+      (Hmor : ∀a b (f : a ⟶ b), F f == G f), F = G :=
+  functor.rec
+    (λ obF homF idF compF,
+      functor.rec
+        (λ obG homG idG compG Hob Hmor, mk_heq Hob Hmor)
+      G)
+    F
+
+--   theorem mk_eq {obF obG : C → D} {homF homG idF idG compF compG} (Hob : ∀x, obF x = obG x)
+--      (Hmor : ∀(a b : C) (f : a ⟶ b), cast (congr_arg (λ x, x a ⟶ x b) (funext Hob)) (homF a b f)
+--                                        = homG a b f)
+--        : mk obF homF idF compF = mk obG homG idG compG :=
+--   dcongr_arg4 mk
+--               (funext Hob)
+--               (funext (λ a, funext (λ b, funext (λ f, sorry ⬝ Hmor a b f))))
+-- -- to fill this sorry use (a generalization of) cast_pull
+--               !proof_irrel
+--               !proof_irrel
+
+--   protected theorem equal {F G : C ⇒ D} : Π (Hob : ∀x, F x = G x)
+--       (Hmor : ∀a b (f : a ⟶ b), cast (congr_arg (λ x, x a ⟶ x b) (funext Hob)) (F f) = G f), F = G :=
+--   functor.rec
+--     (λ obF homF idF compF,
+--       functor.rec
+--         (λ obG homG idG compG Hob Hmor, mk_eq Hob Hmor)
+--       G)
+--     F
+
+
+end functor

old_library/algebra/category/limit.lean

@@ -0,0 +1,37 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Floris van Doorn
+-/
+
+import .natural_transformation
+import data.sigma
+
+open eq eq.ops category functor natural_transformation
+
+namespace limits
+--representable functor
+  section
+  variables {I C : Category} {D : I ⇒ C}
+
+  definition constant_diagram (a : C) : I ⇒ C :=
+  mk (λ i, a)
+     (λ i j u, id)
+     (λ i, rfl)
+     (λ i j k v u, symm !id_compose)
+
+  definition cone := Σ(a : C), constant_diagram a ⟹ D
+  -- definition cone_category : category cone :=
+  -- mk (λa b, sorry)
+  --    (λ a b c g f, sorry)
+  --    (λ a, sorry)
+  --    (λ a b c d h g f, sorry)
+  --    (λ a b f, sorry)
+  --    (λ a b f, sorry)
+
+  end
+end limits
+  -- functor.mk (λ a, sorry)
+  --            (λ a b f, sorry)
+  --            (λ a, sorry)
+  --            (λ a b c g f, sorry)

old_library/algebra/category/morphism.lean

@@ -0,0 +1,286 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Floris van Doorn
+-/
+
+import .basic algebra.relation algebra.binary
+
+open eq eq.ops category
+
+namespace morphism
+  variables {ob : Type} [C : category ob] include C
+  variables {a b c : ob} {g : b ⟶ c} {f : a ⟶ b} {h : b ⟶ a}
+  inductive is_section    [class] (f : a ⟶ b) : Type
+  := mk : ∀{g}, g ∘ f = id → is_section f
+  inductive is_retraction [class] (f : a ⟶ b) : Type
+  := mk : ∀{g}, f ∘ g = id → is_retraction f
+  inductive is_iso        [class] (f : a ⟶ b) : Type
+  := mk : ∀{g}, g ∘ f = id → f ∘ g = id → is_iso f
+
+  attribute is_iso [multiple_instances]
+
+  definition retraction_of (f : a ⟶ b) [H : is_section f] : hom b a :=
+  is_section.rec (λg h, g) H
+  definition section_of    (f : a ⟶ b) [H : is_retraction f] : hom b a :=
+  is_retraction.rec (λg h, g) H
+  definition inverse       (f : a ⟶ b) [H : is_iso f] : hom b a :=
+  is_iso.rec (λg h1 h2, g) H
+
+  postfix `⁻¹` := inverse
+
+  theorem inverse_compose (f : a ⟶ b) [H : is_iso f] : f⁻¹ ∘ f = id :=
+  is_iso.rec (λg h1 h2, h1) H
+
+  theorem compose_inverse (f : a ⟶ b) [H : is_iso f] : f ∘ f⁻¹ = id :=
+  is_iso.rec (λg h1 h2, h2) H
+
+  theorem retraction_compose (f : a ⟶ b) [H : is_section f] : retraction_of f ∘ f = id :=
+  is_section.rec (λg h, h) H
+
+  theorem compose_section (f : a ⟶ b) [H : is_retraction f] : f ∘ section_of f = id :=
+  is_retraction.rec (λg h, h) H
+
+  attribute [instance]
+  theorem iso_imp_retraction (f : a ⟶ b) [H : is_iso f] : is_section f :=
+  is_section.mk !inverse_compose
+
+  attribute [instance]
+  theorem iso_imp_section (f : a ⟶ b) [H : is_iso f] : is_retraction f :=
+  is_retraction.mk !compose_inverse
+
+  attribute [instance]
+  theorem id_is_iso : is_iso (ID a) :=
+  is_iso.mk !id_compose !id_compose
+
+  attribute [instance]
+  theorem inverse_is_iso (f : a ⟶ b) [H : is_iso f] : is_iso (f⁻¹) :=
+  is_iso.mk !compose_inverse !inverse_compose
+
+  theorem left_inverse_eq_right_inverse {f : a ⟶ b} {g g' : hom b a}
+      (Hl : g ∘ f = id) (Hr : f ∘ g' = id) : g = g' :=
+  calc
+      g = g ∘ id        : by rewrite id_right
+    ... = g ∘ f ∘ g'    : by rewrite -Hr
+    ... = (g ∘ f) ∘ g'  : by rewrite assoc
+    ... = id ∘ g'       : by rewrite Hl
+    ... = g'            : by rewrite id_left
+
+  theorem retraction_eq_intro [H : is_section f] (H2 : f ∘ h = id) : retraction_of f = h :=
+  left_inverse_eq_right_inverse !retraction_compose H2
+
+  theorem section_eq_intro [H : is_retraction f] (H2 : h ∘ f = id) : section_of f = h :=
+  symm (left_inverse_eq_right_inverse H2 !compose_section)
+
+  theorem inverse_eq_intro_right [H : is_iso f] (H2 : f ∘ h = id) : f⁻¹ = h :=
+  left_inverse_eq_right_inverse !inverse_compose H2
+
+  theorem inverse_eq_intro_left [H : is_iso f] (H2 : h ∘ f = id) : f⁻¹ = h :=
+  symm (left_inverse_eq_right_inverse H2 !compose_inverse)
+
+  theorem section_eq_retraction (f : a ⟶ b) [Hl : is_section f] [Hr : is_retraction f] :
+      retraction_of f = section_of f :=
+  retraction_eq_intro !compose_section
+
+  theorem section_retraction_imp_iso (f : a ⟶ b) [Hl : is_section f] [Hr : is_retraction f]
+      : is_iso f :=
+  is_iso.mk (subst (section_eq_retraction f) (retraction_compose f)) (compose_section f)
+
+  theorem inverse_unique (H H' : is_iso f) : @inverse _ _ _ _ f H = @inverse _ _ _ _ f H' :=
+  inverse_eq_intro_left !inverse_compose
+
+  theorem inverse_involutive (f : a ⟶ b) [H : is_iso f] : (f⁻¹)⁻¹ = f :=
+  inverse_eq_intro_right !inverse_compose
+
+  theorem retraction_of_id : retraction_of (ID a) = id :=
+  retraction_eq_intro !id_compose
+
+  theorem section_of_id : section_of (ID a) = id :=
+  section_eq_intro !id_compose
+
+  theorem iso_of_id : (ID a)⁻¹ = id :=
+  inverse_eq_intro_left !id_compose
+
+  attribute [instance]
+  theorem composition_is_section [Hf : is_section f] [Hg : is_section g]
+      : is_section (g ∘ f) :=
+  is_section.mk
+    (calc
+      (retraction_of f ∘ retraction_of g) ∘ g ∘ f
+            = retraction_of f ∘ retraction_of g ∘ g ∘ f   : by rewrite -assoc
+        ... = retraction_of f ∘ (retraction_of g ∘ g) ∘ f : by rewrite (assoc _ g f)
+        ... = retraction_of f ∘ id ∘ f                    : by rewrite retraction_compose
+        ... = retraction_of f ∘ f                         : by rewrite id_left
+        ... = id                                          : by rewrite retraction_compose)
+
+  attribute [instance]
+  theorem composition_is_retraction [Hf : is_retraction f] [Hg : is_retraction g]
+      : is_retraction (g ∘ f) :=
+  is_retraction.mk
+    (calc
+      (g ∘ f) ∘ section_of f ∘ section_of g
+            = g ∘ f ∘ section_of f ∘ section_of g   : by rewrite -assoc
+        ... = g ∘ (f ∘ section_of f) ∘ section_of g : by rewrite -assoc
+        ... = g ∘ id ∘ section_of g                 : by rewrite compose_section
+        ... = g ∘ section_of g                      : by rewrite id_left
+        ... = id                                    : by rewrite compose_section)
+
+  attribute [instance]
+  theorem composition_is_inverse [Hf : is_iso f] [Hg : is_iso g] : is_iso (g ∘ f) :=
+  !section_retraction_imp_iso
+
+  structure isomorphic (a b : ob) :=
+    (iso : a ⟶ b)
+    [is_iso : is_iso iso]
+
+  infix `≅`:50 := morphism.isomorphic
+
+  namespace isomorphic
+  open relation
+  attribute is_iso [instance]
+
+  theorem refl  (a     : ob)                           : a ≅ a := mk id
+  theorem symm  ⦃a b   : ob⦄ (H  : a ≅ b)              : b ≅ a := mk (inverse (iso H))
+  theorem trans ⦃a b c : ob⦄ (H1 : a ≅ b) (H2 : b ≅ c) : a ≅ c := mk (iso H2 ∘ iso H1)
+
+  attribute [instance]
+  theorem is_equivalence_eq (T : Type) : is_equivalence (isomorphic : ob → ob → Type) :=
+  is_equivalence.mk refl symm trans
+  end isomorphic
+
+  inductive is_mono [class] (f : a ⟶ b) : Prop :=
+  mk : (∀c (g h : hom c a), f ∘ g = f ∘ h → g = h) → is_mono f
+  inductive is_epi  [class] (f : a ⟶ b) : Prop :=
+  mk : (∀c (g h : hom b c), g ∘ f = h ∘ f → g = h) → is_epi f
+
+  theorem mono_elim [H : is_mono f] {g h : c ⟶ a} (H2 : f ∘ g = f ∘ h) : g = h :=
+  match H with
+    is_mono.mk H3 := H3 c g h H2
+  end
+
+  theorem epi_elim [H : is_epi f] {g h : b ⟶ c} (H2 : g ∘ f = h ∘ f) : g = h :=
+  match H with
+    is_epi.mk H3 := H3 c g h H2
+  end
+
+  attribute [instance]
+  theorem section_is_mono (f : a ⟶ b) [H : is_section f] : is_mono f :=
+  is_mono.mk
+    (λ c g h H, calc
+        g = id ∘ g                    : by rewrite id_left
+      ... = (retraction_of f ∘ f) ∘ g : by rewrite -(retraction_compose f)
+      ... = (retraction_of f ∘ f) ∘ h : by rewrite [-assoc, H, -assoc]
+      ... = id ∘ h                    : by rewrite retraction_compose
+      ... = h                         : by rewrite id_left)
+
+  attribute [instance]
+  theorem retraction_is_epi (f : a ⟶ b) [H : is_retraction f] : is_epi f :=
+  is_epi.mk
+    (λ c g h H, calc
+        g = g ∘ id                 : by rewrite id_right
+      ... = g ∘ f ∘ section_of f   : by rewrite -(compose_section f)
+      ... = h ∘ f ∘ section_of f   : by rewrite [assoc, H, -assoc]
+      ... = h ∘ id                 : by rewrite compose_section
+      ... = h                      : by rewrite id_right)
+
+  --these theorems are now proven automatically using type classes
+  --should they be instances?
+  theorem id_is_mono : is_mono (ID a)
+  theorem id_is_epi  : is_epi  (ID a)
+
+  attribute [instance]
+  theorem composition_is_mono [Hf : is_mono f] [Hg : is_mono g] : is_mono (g ∘ f) :=
+  is_mono.mk
+    (λ d h₁ h₂ H,
+      have H2 : g ∘ (f ∘ h₁) = g ∘ (f ∘ h₂),
+      begin
+        rewrite *assoc, exact H
+      end,
+      mono_elim (mono_elim H2))
+
+  attribute [instance]
+  theorem composition_is_epi  [Hf : is_epi f] [Hg : is_epi g] : is_epi  (g ∘ f) :=
+  is_epi.mk
+    (λ d h₁ h₂ H,
+      have H2 : (h₁ ∘ g) ∘ f = (h₂ ∘ g) ∘ f,
+      begin
+        rewrite -*assoc, exact H
+      end,
+      epi_elim (epi_elim H2))
+end morphism
+namespace morphism
+--rewrite lemmas for inverses, modified from
+--https://github.com/JasonGross/HoTT-categories/blob/master/theories/Categories/Category/Morphisms.v
+  namespace iso
+  section
+  variables {ob : Type} [C : category ob] include C
+  variables {a b c d : ob}
+  variables (f : b ⟶ a) (r : c ⟶ d) (q : b ⟶ c) (p : a ⟶ b)
+  variables (g : d ⟶ c)
+
+  variable [Hq : is_iso q] include Hq
+  theorem compose_pV : q ∘ q⁻¹ = id := !compose_inverse
+  theorem compose_Vp : q⁻¹ ∘ q = id := !inverse_compose
+  theorem compose_V_pp : q⁻¹ ∘ (q ∘ p) = p :=
+  calc
+    q⁻¹ ∘ (q ∘ p) = (q⁻¹ ∘ q) ∘ p : by rewrite assoc
+              ... = id ∘ p        : by rewrite inverse_compose
+              ... = p             : by rewrite id_left
+
+  theorem compose_p_Vp : q ∘ (q⁻¹ ∘ g) = g :=
+  calc
+     q ∘ (q⁻¹ ∘ g)  = (q ∘ q⁻¹) ∘ g : by rewrite assoc
+                ... = id ∘ g        : by rewrite compose_inverse
+                ... = g             : by rewrite id_left
+
+  theorem compose_pp_V : (r ∘ q) ∘ q⁻¹ = r :=
+  calc
+    (r ∘ q) ∘ q⁻¹ = r ∘ q ∘ q⁻¹ : by rewrite assoc
+      ... = r ∘ id              : by rewrite compose_inverse
+      ... = r                   : by rewrite id_right
+
+  theorem compose_pV_p : (f ∘ q⁻¹) ∘ q = f :=
+  calc
+    (f ∘ q⁻¹) ∘ q = f ∘ q⁻¹ ∘ q : by rewrite assoc
+              ... = f ∘ id      : by rewrite inverse_compose
+              ... = f           : by rewrite id_right
+
+  theorem inv_pp [H' : is_iso p] : (q ∘ p)⁻¹ = p⁻¹ ∘ q⁻¹ :=
+  inverse_eq_intro_left
+    (show (p⁻¹ ∘ (q⁻¹)) ∘ q ∘ p = id, from
+     by rewrite [-assoc, compose_V_pp, inverse_compose])
+
+  theorem inv_Vp [H' : is_iso g] : (q⁻¹ ∘ g)⁻¹ = g⁻¹ ∘ q := inverse_involutive q ▸ inv_pp (q⁻¹) g
+  theorem inv_pV [H' : is_iso f] : (q ∘ f⁻¹)⁻¹ = f ∘ q⁻¹ := inverse_involutive f ▸ inv_pp q (f⁻¹)
+  theorem inv_VV [H' : is_iso r] : (q⁻¹ ∘ r⁻¹)⁻¹ = r ∘ q := inverse_involutive r ▸ inv_Vp q (r⁻¹)
+  end
+  section
+  variables {ob : Type} {C : category ob} include C
+  variables {d c b a : ob}
+  variables {i : b ⟶ c} {f : b ⟶ a}
+            {r : c ⟶ d} {q : b ⟶ c} {p : a ⟶ b}
+            {g : d ⟶ c} {h : c ⟶ b}
+            {x : b ⟶ d} {z : a ⟶ c}
+            {y : d ⟶ b} {w : c ⟶ a}
+  variable [Hq : is_iso q] include Hq
+
+  theorem moveR_Mp (H : y = q⁻¹ ∘ g) : q ∘ y = g := H⁻¹ ▸ compose_p_Vp q g
+  theorem moveR_pM (H : w = f ∘ q⁻¹) : w ∘ q = f := H⁻¹ ▸ compose_pV_p f q
+  theorem moveR_Vp (H : z = q ∘ p) : q⁻¹ ∘ z = p := H⁻¹ ▸ compose_V_pp q p
+  theorem moveR_pV (H : x = r ∘ q) : x ∘ q⁻¹ = r := H⁻¹ ▸ compose_pp_V r q
+  theorem moveL_Mp (H : q⁻¹ ∘ g = y) : g = q ∘ y := (moveR_Mp (H⁻¹))⁻¹
+  theorem moveL_pM (H : f ∘ q⁻¹ = w) : f = w ∘ q := (moveR_pM (H⁻¹))⁻¹
+  theorem moveL_Vp (H : q ∘ p = z) : p = q⁻¹ ∘ z := (moveR_Vp (H⁻¹))⁻¹
+  theorem moveL_pV (H : r ∘ q = x) : r = x ∘ q⁻¹ := (moveR_pV (H⁻¹))⁻¹
+  theorem moveL_1V (H : h ∘ q = id) : h = q⁻¹ := (inverse_eq_intro_left H)⁻¹
+  theorem moveL_V1 (H : q ∘ h = id) : h = q⁻¹ := (inverse_eq_intro_right H)⁻¹
+  theorem moveL_1M (H : i ∘ q⁻¹ = id) : i = q := moveL_1V H ⬝ inverse_involutive q
+  theorem moveL_M1 (H : q⁻¹ ∘ i = id) : i = q := moveL_V1 H ⬝ inverse_involutive q
+  theorem moveR_1M (H : id = i ∘ q⁻¹) : q = i := (moveL_1M (H⁻¹))⁻¹
+  theorem moveR_M1 (H : id = q⁻¹ ∘ i) : q = i := (moveL_M1 (H⁻¹))⁻¹
+  theorem moveR_1V (H : id = h ∘ q) : q⁻¹ = h := (moveL_1V (H⁻¹))⁻¹
+  theorem moveR_V1 (H : id = q ∘ h) : q⁻¹ = h := (moveL_V1 (H⁻¹))⁻¹
+  end
+  end iso
+
+end morphism

old_library/algebra/category/natural_transformation.lean

@@ -0,0 +1,51 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Floris van Doorn
+-/
+
+import .functor
+open category eq eq.ops functor
+
+inductive natural_transformation {C D : Category} (F G : C ⇒ D) : Type :=
+mk : Π (η : Π(a : C), hom (F a) (G a)), (Π{a b : C} (f : hom a b), G f ∘ η a = η b ∘ F f)
+ → natural_transformation F G
+
+infixl `⟹`:25 := natural_transformation -- \==>
+
+namespace natural_transformation
+  variables {C D : Category} {F G H I : functor C D}
+
+  -- definition natural_map [coercion] (η : F ⟹ G) : Π(a : C), F a ⟶ G a :=
+  -- natural_transformation.rec (λ x y, x) η
+
+  theorem naturality (η : F ⟹ G) : Π⦃a b : C⦄ (f : a ⟶ b), G f ∘ η a = η b ∘ F f :=
+  natural_transformation.rec (λ x y, y) η
+
+  protected definition compose (η : G ⟹ H) (θ : F ⟹ G) : F ⟹ H :=
+  natural_transformation.mk
+    (λ a, η a ∘ θ a)
+    (λ a b f,
+      calc
+        H f ∘ (η a ∘ θ a) = (H f ∘ η a) ∘ θ a : assoc
+                      ... = (η b ∘ G f) ∘ θ a : naturality η f
+                      ... = η b ∘ (G f ∘ θ a) : assoc
+                      ... = η b ∘ (θ b ∘ F f) : naturality θ f
+                      ... = (η b ∘ θ b) ∘ F f : assoc)
+--congr_arg (λx, η b ∘ x) (naturality θ f) -- this needed to be explicit for some reason (on Oct 24)
+
+  infixr `∘n`:60 := natural_transformation.compose
+  protected theorem assoc (η₃ : H ⟹ I) (η₂ : G ⟹ H) (η₁ : F ⟹ G) :
+      η₃ ∘n (η₂ ∘n η₁) = (η₃ ∘n η₂) ∘n η₁ :=
+  dcongr_arg2 mk (funext (take x, !assoc)) !proof_irrel
+
+  protected definition id {C D : Category} {F : functor C D} : natural_transformation F F :=
+  mk (λa, id) (λa b f, !id_right ⬝ symm !id_left)
+  protected definition ID {C D : Category} (F : functor C D) : natural_transformation F F := natural_transformation.id
+
+  protected theorem id_left (η : F ⟹ G) : natural_transformation.compose natural_transformation.id η = η :=
+  natural_transformation.rec (λf H, dcongr_arg2 mk (funext (take x, !id_left)) !proof_irrel) η
+
+  protected theorem id_right (η : F ⟹ G) : natural_transformation.compose η natural_transformation.id = η :=
+  natural_transformation.rec (λf H, dcongr_arg2 mk (funext (take x, !id_right)) !proof_irrel) η
+end natural_transformation

old_library/algebra/category/yoneda.lean

@@ -0,0 +1,18 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Floris van Doorn
+-/
+
+import .constructions
+
+open eq eq.ops category functor category.ops prod
+
+namespace yoneda
+--representable functor
+  section
+
+
+
+  end
+end yoneda

old_library/algebra/complete_lattice.lean

@@ -0,0 +1,435 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+
+Complete lattices
+
+TODO: define dual complete lattice and simplify proof of dual theorems.
+-/
+import algebra.lattice data.set.basic algebra.monotone
+open set
+
+variable {A : Type}
+
+structure complete_lattice [class] (A : Type) extends lattice A :=
+(Inf : set A → A)
+(Sup : set A → A)
+(Inf_le : ∀ {a : A} {s : set A}, a ∈ s → le (Inf s) a)
+(le_Inf : ∀ {b : A} {s : set A}, (∀ (a : A), a ∈ s → le b a) → le b (Inf s))
+(le_Sup : ∀ {a : A} {s : set A}, a ∈ s → le a (Sup s))
+(Sup_le : ∀ {b : A} {s : set A} (h : ∀ (a : A), a ∈ s → le a b), le (Sup s) b)
+
+section
+  variable [complete_lattice A]
+
+  definition Inf (S : set A) : A := complete_lattice.Inf S
+  prefix `⨅ `:70 := Inf
+
+  definition Sup (S : set A) : A := complete_lattice.Sup S
+  prefix `⨆ `:65 := Sup
+
+  theorem Inf_le {a : A} {s : set A} (H : a ∈ s) : (Inf s) ≤ a := complete_lattice.Inf_le H
+
+  theorem le_Inf {b : A} {s : set A} (H : ∀ (a : A), a ∈ s → b ≤ a) : b ≤ Inf s :=
+    complete_lattice.le_Inf H
+
+  theorem le_Sup {a : A} {s : set A} (H : a ∈ s) : a ≤ Sup s := complete_lattice.le_Sup H
+
+  theorem Sup_le {b : A} {s : set A} (H : ∀ (a : A), a ∈ s → a ≤ b) : Sup s ≤ b :=
+    complete_lattice.Sup_le H
+end
+
+-- Minimal complete_lattice definition based just on Inf.
+-- We later show that complete_lattice_Inf is a complete_lattice.
+structure complete_lattice_Inf [class] (A : Type) extends weak_order A :=
+(Inf : set A → A)
+(Inf_le : ∀ {a : A} {s : set A}, a ∈ s → le (Inf s) a)
+(le_Inf : ∀ {b : A} {s : set A}, (∀ (a : A), a ∈ s → le b a) → le b (Inf s))
+
+-- Minimal complete_lattice definition based just on Sup.
+-- We later show that complete_lattice_Sup is a complete_lattice.
+structure complete_lattice_Sup [class] (A : Type) extends weak_order A :=
+(Sup : set A → A)
+(le_Sup : ∀ {a : A} {s : set A}, a ∈ s → le a (Sup s))
+(Sup_le : ∀ {b : A} {s : set A} (h : ∀ (a : A), a ∈ s → le a b), le (Sup s) b)
+
+namespace complete_lattice_Inf
+variable [C : complete_lattice_Inf A]
+include C
+definition Sup (s : set A) : A :=
+Inf {b | ∀ a, a ∈ s → a ≤ b}
+
+local prefix `⨅`:70 := Inf
+local prefix `⨆`:65 := Sup
+
+lemma le_Sup {a : A} {s : set A} : a ∈ s → a ≤ ⨆ s :=
+suppose a ∈ s, le_Inf
+  (show ∀ (b : A), (∀ (a : A), a ∈ s → a ≤ b) → a ≤ b, from
+   take b, assume h, h a `a ∈ s`)
+
+lemma Sup_le {b : A} {s : set A} (h : ∀ (a : A), a ∈ s → a ≤ b) : ⨆ s ≤ b :=
+Inf_le h
+
+definition inf (a b : A) := ⨅ '{a, b}
+definition sup (a b : A) := ⨆ '{a, b}
+
+local infix `⊓` := inf
+local infix `⊔` := sup
+
+lemma inf_le_left (a b : A) : a ⊓ b ≤ a :=
+Inf_le !mem_insert
+
+lemma inf_le_right (a b : A) : a ⊓ b ≤ b :=
+Inf_le (!mem_insert_of_mem !mem_insert)
+
+lemma le_inf {a b c : A} : c ≤ a → c ≤ b → c ≤ a ⊓ b :=
+assume h₁ h₂,
+le_Inf (take x, suppose x ∈ '{a, b},
+  or.elim (eq_or_mem_of_mem_insert this)
+    (suppose x = a, begin subst x, exact h₁ end)
+    (suppose x ∈ '{b},
+      have x = b, from !eq_of_mem_singleton this,
+      begin subst x, exact h₂ end))
+
+lemma le_sup_left (a b : A) : a ≤ a ⊔ b :=
+le_Sup !mem_insert
+
+lemma le_sup_right (a b : A) : b ≤ a ⊔ b :=
+le_Sup (!mem_insert_of_mem !mem_insert)
+
+lemma sup_le {a b c : A} : a ≤ c → b ≤ c → a ⊔ b ≤ c :=
+assume h₁ h₂,
+Sup_le (take x, suppose x ∈ '{a, b},
+  or.elim (eq_or_mem_of_mem_insert this)
+    (suppose x = a, by subst x; assumption)
+    (suppose x ∈ '{b},
+      have x = b, from !eq_of_mem_singleton this,
+      by subst x; assumption))
+end complete_lattice_Inf
+
+-- Every complete_lattice_Inf is a complete_lattice_Sup
+definition complete_lattice_Inf_to_complete_lattice_Sup [C : complete_lattice_Inf A] :
+  complete_lattice_Sup A :=
+⦃ complete_lattice_Sup, C ⦄
+
+-- Every complete_lattice_Inf is a complete_lattice
+attribute [trans_instance]
+definition complete_lattice_Inf_to_complete_lattice [C : complete_lattice_Inf A] :
+  complete_lattice A :=
+⦃ complete_lattice, C ⦄
+
+namespace complete_lattice_Sup
+variable [C : complete_lattice_Sup A]
+include C
+definition Inf (s : set A) : A :=
+Sup {b | ∀ a, a ∈ s → b ≤ a}
+
+lemma Inf_le {a : A} {s : set A} : a ∈ s → Inf s ≤ a :=
+suppose a ∈ s, Sup_le
+  (show ∀ (b : A), (∀ (a : A), a ∈ s → b ≤ a) → b ≤ a, from
+   take b, assume h, h a `a ∈ s`)
+
+lemma le_Inf {b : A} {s : set A} (h : ∀ (a : A), a ∈ s → b ≤ a) : b ≤ Inf s :=
+le_Sup h
+
+local prefix `⨅`:70 := Inf
+local prefix `⨆`:65 := Sup
+
+definition inf (a b : A) := ⨅ '{a, b}
+definition sup (a b : A) := ⨆ '{a, b}
+
+local infix `⊓` := inf
+local infix `⊔` := sup
+
+lemma inf_le_left (a b : A) : a ⊓ b ≤ a :=
+Inf_le !mem_insert
+
+lemma inf_le_right (a b : A) : a ⊓ b ≤ b :=
+Inf_le (!mem_insert_of_mem !mem_insert)
+
+lemma le_inf {a b c : A} : c ≤ a → c ≤ b → c ≤ a ⊓ b :=
+assume h₁ h₂,
+le_Inf (take x, suppose x ∈ '{a, b},
+  or.elim (eq_or_mem_of_mem_insert this)
+    (suppose x = a, begin subst x, exact h₁ end)
+    (suppose x ∈ '{b},
+      have x = b, from !eq_of_mem_singleton this,
+      begin subst x, exact h₂ end))
+
+lemma le_sup_left (a b : A) : a ≤ a ⊔ b :=
+le_Sup !mem_insert
+
+lemma le_sup_right (a b : A) : b ≤ a ⊔ b :=
+le_Sup (!mem_insert_of_mem !mem_insert)
+
+lemma sup_le {a b c : A} : a ≤ c → b ≤ c → a ⊔ b ≤ c :=
+assume h₁ h₂,
+Sup_le (take x, suppose x ∈ '{a, b},
+  or.elim (eq_or_mem_of_mem_insert this)
+    (assume H : x = a, by subst x; exact h₁)
+    (suppose x ∈ '{b},
+      have x = b, from !eq_of_mem_singleton this,
+      by subst x; exact h₂))
+
+end complete_lattice_Sup
+
+-- Every complete_lattice_Sup is a complete_lattice_Inf
+definition complete_lattice_Sup_to_complete_lattice_Inf [C : complete_lattice_Sup A] :
+  complete_lattice_Inf A :=
+⦃ complete_lattice_Inf, C ⦄
+
+-- Every complete_lattice_Sup is a complete_lattice
+section
+attribute [trans_instance]
+definition complete_lattice_Sup_to_complete_lattice [C : complete_lattice_Sup A] :
+  complete_lattice A :=
+⦃ complete_lattice, C ⦄
+end
+
+section complete_lattice
+variable [C : complete_lattice A]
+include C
+
+variable {f : A → A}
+premise  (mono : nondecreasing f)
+
+theorem knaster_tarski : ∃ a, f a = a ∧ ∀ b, f b = b → a ≤ b :=
+let a := ⨅ {u | f u ≤ u} in
+have h₁ : f a = a, from
+  have ge : f a ≤ a, from
+    have ∀ b, b ∈ {u | f u ≤ u} → f a ≤ b, from
+      take b, suppose f b ≤ b,
+      have a ≤ b,     from Inf_le this,
+      have f a ≤ f b, from mono this,
+      le.trans `f a ≤ f b` `f b ≤ b`,
+    le_Inf this,
+  have le : a ≤ f a, from
+    have f (f a) ≤ f a,  from !mono ge,
+    have f a ∈ {u | f u ≤ u}, from this,
+    Inf_le this,
+  le.antisymm ge le,
+have h₂ : ∀ b, f b = b → a ≤ b, from
+  take b,
+  suppose f b = b,
+  have b ∈ {u | f u ≤ u}, from
+    show f b ≤ b, by rewrite this,
+  Inf_le this,
+exists.intro a (and.intro h₁ h₂)
+
+theorem knaster_tarski_dual : ∃ a, f a = a ∧ ∀ b, f b = b → b ≤ a :=
+let a := ⨆ {u | u ≤ f u} in
+have h₁ : f a = a, from
+  have le : a ≤ f a, from
+    have ∀ b, b ∈ {u | u ≤ f u} → b ≤ f a, from
+      take b, suppose b ≤ f b,
+      have b ≤ a,     from le_Sup this,
+      have f b ≤ f a, from mono this,
+      le.trans `b ≤ f b` `f b ≤ f a`,
+    Sup_le this,
+  have ge : f a ≤ a, from
+    have f a ≤ f (f a),  from !mono le,
+    have f a ∈ {u | u ≤ f u}, from this,
+    le_Sup this,
+  le.antisymm ge le,
+have h₂ : ∀ b, f b = b → b ≤ a, from
+  take b,
+  suppose f b = b,
+  have b ≤ f b, by rewrite this,
+  le_Sup this,
+exists.intro a (and.intro h₁ h₂)
+
+/- top and bot -/
+
+definition bot : A := ⨅ univ
+definition top : A := ⨆ univ
+notation `⊥` := bot
+notation `⊤` := top
+
+lemma bot_le (a : A) : ⊥ ≤ a :=
+Inf_le !mem_univ
+
+lemma eq_bot {a : A} : (∀ b, a ≤ b) → a = ⊥ :=
+assume h,
+have a ≤ ⊥, from le_Inf (take b bin, h b),
+le.antisymm this !bot_le
+
+lemma le_top (a : A) : a ≤ ⊤ :=
+le_Sup !mem_univ
+
+lemma eq_top {a : A} : (∀ b, b ≤ a) → a = ⊤ :=
+assume h,
+have ⊤ ≤ a, from Sup_le (take b bin, h b),
+le.antisymm !le_top this
+
+/- general facts about complete lattices -/
+
+lemma Inf_singleton {a : A} : ⨅'{a} = a :=
+have ⨅'{a} ≤ a, from
+  Inf_le !mem_insert,
+have a ≤ ⨅'{a}, from
+  le_Inf (take b, suppose b ∈ '{a}, have b = a, from eq_of_mem_singleton this, by rewrite this),
+le.antisymm `⨅'{a} ≤ a` `a ≤ ⨅'{a}`
+
+lemma Sup_singleton {a : A} : ⨆'{a} = a :=
+have ⨆'{a} ≤ a, from
+  Sup_le (take b, suppose b ∈ '{a}, have b = a, from eq_of_mem_singleton this, by rewrite this),
+have a ≤ ⨆'{a}, from
+  le_Sup !mem_insert,
+le.antisymm `⨆'{a} ≤ a` `a ≤ ⨆'{a}`
+
+lemma Inf_antimono {s₁ s₂ : set A} : s₁ ⊆ s₂ → ⨅ s₂ ≤ ⨅ s₁ :=
+suppose s₁ ⊆ s₂, le_Inf (take a : A, suppose a ∈ s₁, Inf_le (mem_of_subset_of_mem `s₁ ⊆ s₂` `a ∈ s₁`))
+
+lemma Sup_mono {s₁ s₂ : set A} : s₁ ⊆ s₂ → ⨆ s₁ ≤ ⨆ s₂ :=
+suppose s₁ ⊆ s₂, Sup_le (take a : A, suppose a ∈ s₁, le_Sup (mem_of_subset_of_mem `s₁ ⊆ s₂` `a ∈ s₁`))
+
+lemma Inf_union (s₁ s₂ : set A) : ⨅ (s₁ ∪ s₂) = (⨅s₁) ⊓ (⨅s₂) :=
+have le₁ : ⨅ (s₁ ∪ s₂) ≤ (⨅s₁) ⊓ (⨅s₂), from
+ !le_inf
+     (le_Inf (take a : A, suppose a ∈ s₁, Inf_le (mem_unionl `a ∈ s₁`)))
+     (le_Inf (take a : A, suppose a ∈ s₂, Inf_le (mem_unionr `a ∈ s₂`))),
+have le₂ : (⨅s₁) ⊓ (⨅s₂) ≤ ⨅ (s₁ ∪ s₂), from
+  le_Inf (take a : A, suppose a ∈ s₁ ∪ s₂,
+    or.elim this
+      (suppose a ∈ s₁,
+        have (⨅s₁) ⊓ (⨅s₂) ≤ ⨅s₁, from !inf_le_left,
+        have ⨅s₁ ≤ a, from Inf_le `a ∈ s₁`,
+        le.trans `(⨅s₁) ⊓ (⨅s₂) ≤ ⨅s₁` `⨅s₁ ≤ a`)
+      (suppose a ∈ s₂,
+        have (⨅s₁) ⊓ (⨅s₂) ≤ ⨅s₂, from !inf_le_right,
+        have ⨅s₂ ≤ a, from Inf_le `a ∈ s₂`,
+        le.trans `(⨅s₁) ⊓ (⨅s₂) ≤ ⨅s₂` `⨅s₂ ≤ a`)),
+le.antisymm le₁ le₂
+
+lemma Sup_union (s₁ s₂ : set A) : ⨆ (s₁ ∪ s₂) = (⨆s₁) ⊔ (⨆s₂) :=
+have le₁ : ⨆ (s₁ ∪ s₂) ≤ (⨆s₁) ⊔ (⨆s₂), from
+  Sup_le (take a : A, suppose a ∈ s₁ ∪ s₂,
+    or.elim this
+      (suppose a ∈ s₁,
+        have a ≤ ⨆s₁, from le_Sup `a ∈ s₁`,
+        have ⨆s₁ ≤ (⨆s₁) ⊔ (⨆s₂), from !le_sup_left,
+        le.trans `a ≤ ⨆s₁` `⨆s₁ ≤ (⨆s₁) ⊔ (⨆s₂)`)
+      (suppose a ∈ s₂,
+        have a ≤ ⨆s₂, from le_Sup `a ∈ s₂`,
+        have ⨆s₂ ≤ (⨆s₁) ⊔ (⨆s₂), from !le_sup_right,
+        le.trans `a ≤ ⨆s₂` `⨆s₂ ≤ (⨆s₁) ⊔ (⨆s₂)`)),
+have le₂ : (⨆s₁) ⊔ (⨆s₂) ≤ ⨆ (s₁ ∪ s₂), from
+  !sup_le
+    (Sup_le (take a : A, suppose a ∈ s₁, le_Sup (mem_unionl `a ∈ s₁`)))
+    (Sup_le (take a : A, suppose a ∈ s₂, le_Sup (mem_unionr `a ∈ s₂`))),
+le.antisymm le₁ le₂
+
+lemma Inf_empty_eq_Sup_univ : ⨅ (∅ : set A) = ⨆ univ :=
+have le₁ : ⨅ (∅ : set A) ≤ ⨆ univ, from
+  le_Sup !mem_univ,
+have le₂ : ⨆ univ ≤ ⨅ ∅, from
+  le_Inf (take a : A, suppose a ∈ ∅, absurd this !not_mem_empty),
+le.antisymm le₁ le₂
+
+lemma Sup_empty_eq_Inf_univ : ⨆ (∅ : set A) = ⨅ univ :=
+have le₁ : ⨆ (∅ : set A) ≤ ⨅ univ, from
+  Sup_le (take a, suppose a ∈ ∅, absurd this !not_mem_empty),
+have le₂ : ⨅ univ ≤ ⨆ (∅ : set A), from
+  Inf_le !mem_univ,
+le.antisymm le₁ le₂
+
+lemma Sup_pair (a b : A) : Sup '{a, b} = sup a b :=
+by rewrite [insert_eq, Sup_union, *Sup_singleton]
+
+lemma Inf_pair (a b : A) : Inf '{a, b} = inf a b :=
+by rewrite [insert_eq, Inf_union, *Inf_singleton]
+
+end complete_lattice
+
+/- complete lattice instances  -/
+
+section
+open eq.ops complete_lattice
+
+attribute [instance]
+definition complete_lattice_fun (A B : Type) [complete_lattice B] :
+    complete_lattice (A → B) :=
+⦃ complete_lattice, lattice_fun A B,
+  Inf := λS x, Inf ((λf, f x) ' S),
+  le_Inf := take f S H x,
+    le_Inf (take y Hy, obtain g `g ∈ S` `g x = y`, from Hy, `g x = y` ▸ H g `g ∈ S` x),
+  Inf_le := take f S `f ∈ S` x,
+    Inf_le (exists.intro f (and.intro `f ∈ S` rfl)),
+  Sup := λS x, Sup ((λf, f x) ' S),
+  le_Sup := take f S `f ∈ S` x,
+    le_Sup (exists.intro f (and.intro `f ∈ S` rfl)),
+  Sup_le := take f S H x,
+    Sup_le (take y Hy, obtain g `g ∈ S` `g x = y`, from Hy, `g x = y` ▸ H g `g ∈ S` x)
+⦄
+
+section
+local attribute classical.prop_decidable [instance] -- Prop and set are only in the classical setting a complete lattice
+
+attribute [instance]
+definition complete_lattice_Prop : complete_lattice Prop :=
+⦃ complete_lattice, lattice_Prop,
+  Inf := λS, false ∉ S,
+  le_Inf := take x S H Hx Hf,
+    H _ Hf Hx,
+  Inf_le := take x S Hx Hf,
+    (classical.cases_on x (take x, true.intro) Hf) Hx,
+  Sup := λS, true ∈ S,
+  le_Sup := take x S Hx H,
+    iff_subst (iff.intro (take H, true.intro) (take H', H)) Hx,
+  Sup_le := take x S H Ht,
+    H _ Ht true.intro
+⦄
+
+lemma sInter_eq_Inf_fun {A : Type} (S : set (set A)) : ⋂₀ S = @Inf (A → Prop) _ S :=
+funext (take x,
+  calc
+    (⋂₀ S) x = ∀₀ P ∈ S, P x : rfl
+    ... = ¬ (∃₀ P ∈ S, P x = false) :
+    begin
+      rewrite not_bounded_exists,
+      apply bounded_forall_congr,
+      intros,
+      rewrite eq_false,
+      rewrite not_not_iff
+    end
+    ... = @Inf (A → Prop) _ S x : rfl)
+
+lemma sUnion_eq_Sup_fun {A : Type} (S : set (set A)) : ⋃₀ S = @Sup (A → Prop) _ S :=
+funext (take x,
+  calc
+    (⋃₀ S) x = ∃₀ P ∈ S, P x : rfl
+    ... = (∃₀ P ∈ S, P x = true) :
+    begin
+      apply bounded_exists_congr,
+      intros,
+      rewrite eq_true
+    end
+    ... = @Sup (A → Prop) _ S x : rfl)
+
+attribute [instance]
+definition complete_lattice_set (A : Type) : complete_lattice (set A) :=
+⦃ complete_lattice,
+  le := subset,
+  le_refl := @le_refl (A → Prop) _,
+  le_trans := @le_trans (A → Prop) _,
+  le_antisymm := @le_antisymm (A → Prop) _,
+  inf := inter,
+  sup := union,
+  inf_le_left := @inf_le_left (A → Prop) _,
+  inf_le_right := @inf_le_right (A → Prop) _,
+  le_inf := @le_inf (A → Prop) _,
+  le_sup_left := @le_sup_left (A → Prop) _,
+  le_sup_right := @le_sup_right (A → Prop) _,
+  sup_le := @sup_le (A → Prop) _,
+  Inf := sInter,
+  Sup := sUnion,
+  le_Inf := begin intros X S H, rewrite sInter_eq_Inf_fun, apply (@le_Inf (A → Prop) _), exact H end,
+  Inf_le := begin intros X S H, rewrite sInter_eq_Inf_fun, apply (@Inf_le (A → Prop) _), exact H end,
+  le_Sup := begin intros X S H, rewrite sUnion_eq_Sup_fun, apply (@le_Sup (A → Prop) _), exact H end,
+  Sup_le := begin intros X S H, rewrite sUnion_eq_Sup_fun, apply (@Sup_le (A → Prop) _), exact H end
+⦄
+
+end
+
+end

old_library/algebra/field.lean

@@ -0,0 +1,622 @@
+/-
+Copyright (c) 2014 Robert Lewis. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Robert Lewis
+
+Structures with multiplicative and additive components, including division rings and fields.
+The development is modeled after Isabelle's library.
+-/
+import algebra.ring
+open eq
+
+variable {A : Type}
+
+structure division_ring [class] (A : Type) extends ring A, has_inv A, zero_ne_one_class A :=
+  (mul_inv_cancel : ∀{a}, a ≠ zero → mul a (inv a) = one)
+  (inv_mul_cancel : ∀{a}, a ≠ zero → mul (inv a) a = one)
+
+section division_ring
+  variables [s : division_ring A] {a b c : A}
+  include s
+
+  protected definition algebra.div (a b : A) : A := a * b⁻¹
+
+  attribute [instance]
+  definition division_ring_has_div : has_div A :=
+  has_div.mk algebra.div
+
+  attribute [simp]
+  lemma division.def (a b : A) : a / b = a * b⁻¹ :=
+  rfl
+
+  attribute [simp]
+  theorem mul_inv_cancel (H : a ≠ 0) : a * a⁻¹ = 1 :=
+  division_ring.mul_inv_cancel H
+
+  attribute [simp]
+  theorem inv_mul_cancel (H : a ≠ 0) : a⁻¹ * a = 1 :=
+  division_ring.inv_mul_cancel H
+
+  theorem inv_eq_one_div (a : A) : a⁻¹ = 1 / a := eq.symm $ one_mul (a⁻¹)
+
+  theorem div_eq_mul_one_div (a b : A) : a / b = a * (1 / b) :=
+  sorry -- by simp
+
+  attribute [simp]
+  theorem mul_one_div_cancel (H : a ≠ 0) : a * (1 / a) = 1 :=
+  sorry -- by simp
+
+  attribute [simp]
+  theorem one_div_mul_cancel (H : a ≠ 0) : (1 / a) * a = 1 :=
+  sorry -- by simp
+
+  attribute [simp]
+  theorem div_self (H : a ≠ 0) : a / a = 1 :=
+  sorry -- by simp
+
+  attribute [simp]
+  theorem one_div_one : 1 / 1 = (1:A) :=
+  div_self (ne.symm zero_ne_one)
+
+  theorem mul_div_assoc (a b : A) : (a * b) / c = a * (b / c) :=
+  sorry -- by simp
+
+  theorem one_div_ne_zero (H : a ≠ 0) : 1 / a ≠ 0 :=
+  sorry
+  /-
+    assume H2 : 1 / a = 0,
+    have C1 : 0 = (1:A), from symm (by rewrite [-(mul_one_div_cancel H), H2, mul_zero]),
+    absurd C1 zero_ne_one
+  -/
+
+  attribute [simp]
+  theorem one_inv_eq : 1⁻¹ = (1:A) :=
+  sorry -- by rewrite [-mul_one, inv_mul_cancel (ne.symm (@zero_ne_one A _))]
+
+  attribute [simp]
+  theorem div_one (a : A) : a / 1 = a :=
+  sorry -- by simp
+
+  attribute [simp]
+  theorem zero_div (a : A) : 0 / a = 0 :=
+  sorry -- by simp
+
+  -- note: integral domain has a "mul_ne_zero". A commutative division ring is an integral
+  -- domain, but let's not define that class for now.
+  theorem division_ring.mul_ne_zero (Ha : a ≠ 0) (Hb : b ≠ 0) : a * b ≠ 0 :=
+  sorry
+  /-
+  assume H : a * b = 0,
+  have C1 : a = 0, by rewrite [-mul_one, -(mul_one_div_cancel Hb), -mul.assoc, H, zero_mul],
+  absurd C1 Ha
+  -/
+
+  theorem mul_ne_zero_comm (H : a * b ≠ 0) : b * a ≠ 0 :=
+  have H2 : a ≠ 0 ∧ b ≠ 0, from ne_zero_and_ne_zero_of_mul_ne_zero H,
+  division_ring.mul_ne_zero (and.right H2) (and.left H2)
+
+  theorem eq_one_div_of_mul_eq_one (H : a * b = 1) : b = 1 / a :=
+  sorry
+  /-
+  have a ≠ 0, from
+    suppose a = 0,
+    have 0 = (1:A), by inst_simp,
+      absurd this zero_ne_one,
+  have b = (1 / a) * a * b, by inst_simp,
+  show b = 1 / a, by inst_simp
+  -/
+
+  theorem eq_one_div_of_mul_eq_one_left (H : b * a = 1) : b = 1 / a :=
+  sorry
+  /-
+  have a ≠ 0, from
+    suppose a = 0,
+    have 0 = (1:A), by inst_simp,
+      absurd this zero_ne_one,
+  by inst_simp
+  -/
+
+  theorem division_ring.one_div_mul_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) :
+      (1 / a) * (1 / b) = 1 / (b * a) :=
+  sorry
+  /-
+  have (b * a) * ((1 / a) * (1 / b)) = 1, by inst_simp,
+  eq_one_div_of_mul_eq_one this
+  -/
+
+  theorem one_div_neg_one_eq_neg_one : (1:A) / (-1) = -1 :=
+  sorry
+  /-
+  have (-1) * (-1) = (1:A), by inst_simp,
+  symm (eq_one_div_of_mul_eq_one this)
+  -/
+
+  theorem division_ring.one_div_neg_eq_neg_one_div (H : a ≠ 0) : 1 / (- a) = - (1 / a) :=
+  have -1 ≠ (0:A), from
+   (suppose -1 = 0, absurd (symm (calc
+          1 = -(-1)  : eq.symm $ neg_neg 1
+        ... = -0     : sorry -- by rewrite this
+        ... = (0:A)  : neg_zero)) zero_ne_one),
+    calc
+      1 / (- a) = 1 / ((-1) * a)        : sorry -- by rewrite neg_eq_neg_one_mul
+            ... = (1 / a) * (1 / (- 1)) : sorry -- by rewrite (division_ring.one_div_mul_one_div H this)
+            ... = (1 / a) * (-1)        : sorry -- by rewrite one_div_neg_one_eq_neg_one
+            ... = - (1 / a)             : sorry -- by rewrite mul_neg_one_eq_neg
+
+  theorem div_neg_eq_neg_div (b : A) (Ha : a ≠ 0) : b / (- a) = - (b / a) :=
+    calc
+      b / (- a) = b * (1 / (- a)) : sorry -- by rewrite -inv_eq_one_div
+            ... = b * -(1 / a)    : sorry -- by rewrite (division_ring.one_div_neg_eq_neg_one_div Ha)
+            ... = -(b * (1 / a))  : sorry -- by rewrite neg_mul_eq_mul_neg
+            ... = - (b * a⁻¹)     : sorry -- by rewrite inv_eq_one_div
+
+  theorem neg_div (a b : A) : (-b) / a = - (b / a) :=
+    sorry -- by rewrite [neg_eq_neg_one_mul, mul_div_assoc, -neg_eq_neg_one_mul]
+
+  theorem division_ring.neg_div_neg_eq (a : A) {b : A} (Hb : b ≠ 0) : (-a) / (-b) = a / b :=
+    sorry -- by rewrite [(div_neg_eq_neg_div _ Hb), neg_div, neg_neg]
+
+  theorem division_ring.one_div_one_div (H : a ≠ 0) : 1 / (1 / a) = a :=
+    symm (eq_one_div_of_mul_eq_one_left (mul_one_div_cancel H))
+
+  theorem division_ring.eq_of_one_div_eq_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) (H : 1 / a = 1 / b) :
+      a = b :=
+    sorry -- by rewrite [-(division_ring.one_div_one_div Ha), H, (division_ring.one_div_one_div Hb)]
+
+  attribute [simp]
+  theorem mul_inv_eq (Ha : a ≠ 0) (Hb : b ≠ 0) : (b * a)⁻¹ = a⁻¹ * b⁻¹ :=
+  sorry
+  /-
+    eq.symm (calc
+      a⁻¹ * b⁻¹ = (1 / a) * (1 / b) : by inst_simp
+      ... = (1 / (b * a))           : division_ring.one_div_mul_one_div Ha Hb
+      ... = (b * a)⁻¹               : by simp)
+  -/
+
+  theorem mul_div_cancel (a : A) {b : A} (Hb : b ≠ 0) : a * b / b = a :=
+  sorry -- by simp
+
+  theorem div_mul_cancel (a : A) {b : A} (Hb : b ≠ 0) : a / b * b = a :=
+  sorry -- by simp
+
+  theorem div_add_div_same (a b c : A) : a / c + b / c = (a + b) / c := eq.symm $ right_distrib a b (c⁻¹)
+
+  theorem div_sub_div_same (a b c : A) : (a / c) - (b / c) = (a - b) / c :=
+  sorry -- by rewrite [sub_eq_add_neg, -neg_div, div_add_div_same]
+
+  theorem one_div_mul_add_mul_one_div_eq_one_div_add_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) :
+          (1 / a) * (a + b) * (1 / b) = 1 / a + 1 / b :=
+  sorry
+  /-
+    by rewrite [(left_distrib (1 / a)), (one_div_mul_cancel Ha), right_distrib, one_mul,
+      mul.assoc, (mul_one_div_cancel Hb), mul_one, add.comm]
+  -/
+  theorem one_div_mul_sub_mul_one_div_eq_one_div_add_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) :
+          (1 / a) * (b - a) * (1 / b) = 1 / a - 1 / b :=
+  sorry
+  /-
+    by rewrite [(mul_sub_left_distrib (1 / a)), (one_div_mul_cancel Ha), mul_sub_right_distrib,
+      one_mul, mul.assoc, (mul_one_div_cancel Hb), mul_one]
+  -/
+  theorem div_eq_one_iff_eq (a : A) {b : A} (Hb : b ≠ 0) : a / b = 1 ↔ a = b :=
+  sorry
+  /-
+    iff.intro
+    (suppose a / b = 1, calc
+      a   = a / b * b : by inst_simp
+      ... = 1 * b     : by rewrite this
+      ... = b         : by simp)
+    (suppose a = b, by simp)
+  -/
+
+  theorem eq_of_div_eq_one (a : A) {b : A} (Hb : b ≠ 0) : a / b = 1 → a = b :=
+  iff.mp $ div_eq_one_iff_eq a Hb
+
+  theorem eq_div_iff_mul_eq (a : A) {b : A} (Hc : c ≠ 0) : a = b / c ↔ a * c = b :=
+  sorry
+  /-
+    iff.intro
+      (suppose a = b / c, by rewrite [this, (!div_mul_cancel Hc)])
+      (suppose a * c = b, by rewrite [-(!mul_div_cancel Hc), this])
+  -/
+
+  theorem eq_div_of_mul_eq (a b : A) {c : A} (Hc : c ≠ 0) : a * c = b → a = b / c :=
+  iff.mpr $ eq_div_iff_mul_eq a Hc
+
+  theorem mul_eq_of_eq_div (a b: A) {c : A} (Hc : c ≠ 0) : a = b / c → a * c = b :=
+  iff.mp $ eq_div_iff_mul_eq a Hc
+
+  theorem add_div_eq_mul_add_div (a b : A) {c : A} (Hc : c ≠ 0) : a + b / c = (a * c + b) / c :=
+  sorry
+  /-
+    have (a + b / c) * c = a * c + b, by rewrite [right_distrib, (!div_mul_cancel Hc)],
+    (iff.elim_right (!eq_div_iff_mul_eq Hc)) this
+  -/
+
+  theorem mul_mul_div (a : A) {c : A} (Hc : c ≠ 0) : a = a * c * (1 / c) :=
+  sorry -- by simp
+
+  -- There are many similar rules to these last two in the Isabelle library
+  -- that haven't been ported yet. Do as necessary.
+end division_ring
+
+structure field [class] (A : Type) extends division_ring A, comm_ring A
+
+section field
+  variables [s : field A] {a b c d: A}
+  include s
+
+  theorem field.one_div_mul_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : (1 / a) * (1 / b) =  1 / (a * b) :=
+  sorry -- by rewrite [(division_ring.one_div_mul_one_div Ha Hb), mul.comm b]
+
+  theorem field.div_mul_right (Hb : b ≠ 0) (H : a * b ≠ 0) : a / (a * b) = 1 / b :=
+  sorry
+  /-
+  have a ≠ 0, from and.left (ne_zero_and_ne_zero_of_mul_ne_zero H),
+    symm (calc
+      1 / b = a * ((1 / a) * (1 / b)) : by inst_simp
+        ... = a * (1 / (b * a))       : by rewrite (division_ring.one_div_mul_one_div this Hb)
+        ... = a * (a * b)⁻¹           : by inst_simp)
+  -/
+
+  theorem field.div_mul_left (Ha : a ≠ 0) (H : a * b ≠ 0) : b / (a * b) = 1 / a :=
+    let H1 : b * a ≠ 0 := mul_ne_zero_comm H in
+    sorry -- by rewrite [mul.comm a, (field.div_mul_right Ha H1)]
+
+  theorem mul_div_cancel_left (Ha : a ≠ 0) : a * b / a = b :=
+    sorry -- by rewrite [mul.comm a, (!mul_div_cancel Ha)]
+
+  theorem mul_div_cancel' (Hb : b ≠ 0) : b * (a / b) = a :=
+    sorry -- by rewrite [mul.comm, (!div_mul_cancel Hb)]
+
+  theorem one_div_add_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : 1 / a + 1 / b = (a + b) / (a * b) :=
+    have a * b ≠ 0, from (division_ring.mul_ne_zero Ha Hb),
+    sorry -- by rewrite [add.comm, -(field.div_mul_left Ha this), -(field.div_mul_right Hb this), *division.def, -right_distrib]
+
+  theorem field.div_mul_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0) (Hd : d ≠ 0) :
+      (a / b) * (c / d) = (a * c) / (b * d) :=
+  sorry -- by inst_simp
+
+  theorem mul_div_mul_left (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
+      (c * a) / (c * b) = a / b :=
+  sorry -- by rewrite [-(!field.div_mul_div Hc Hb), (div_self Hc), one_mul]
+
+  theorem mul_div_mul_right (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
+      (a * c) / (b * c) = a / b :=
+  sorry -- by rewrite [(mul.comm a), (mul.comm b), (!mul_div_mul_left Hb Hc)]
+
+  theorem div_mul_eq_mul_div (a b c : A) : (b / c) * a = (b * a) / c :=
+  sorry -- by rewrite [*division.def, mul.assoc, (mul.comm c⁻¹), -mul.assoc]
+
+  theorem field.div_mul_eq_mul_div_comm (a b : A) {c : A} (Hc : c ≠ 0) :
+      (b / c) * a = b * (a / c) :=
+  sorry
+  /-
+  by rewrite [(div_mul_eq_mul_div), -(one_mul c), -(!field.div_mul_div (ne.symm zero_ne_one) Hc),
+              div_one, one_mul]
+  -/
+
+  theorem div_add_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0) (Hd : d ≠ 0) :
+      (a / b) + (c / d) = ((a * d) + (b * c)) / (b * d) :=
+  sorry
+  --  by rewrite [-(!mul_div_mul_right Hb Hd), -(!mul_div_mul_left Hd Hb), div_add_div_same]
+
+  theorem div_sub_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0) (Hd : d ≠ 0) :
+      (a / b) - (c / d) = ((a * d) - (b * c)) / (b * d) :=
+  sorry
+  /-
+      by rewrite [*sub_eq_add_neg, neg_eq_neg_one_mul, -mul_div_assoc, (!div_add_div Hb Hd),
+         -mul.assoc, (mul.comm b), mul.assoc, -neg_eq_neg_one_mul]
+  -/
+
+  theorem mul_eq_mul_of_div_eq_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0)
+      (Hd : d ≠ 0) (H : a / b = c / d) : a * d = c * b :=
+  sorry
+  /-
+    by rewrite [-mul_one, mul.assoc, (mul.comm d), -mul.assoc, -(div_self Hb),
+         -(!field.div_mul_eq_mul_div_comm Hb), H, (div_mul_eq_mul_div), (!div_mul_cancel Hd)]
+  -/
+
+  theorem field.one_div_div (Ha : a ≠ 0) (Hb : b ≠ 0) : 1 / (a / b) = b / a :=
+  sorry
+  /-
+    have (a / b) * (b / a) = 1, from calc
+      (a / b) * (b / a) = (a * b) / (b * a) : !field.div_mul_div Hb Ha
+      ... = (a * b) / (a * b) : by rewrite mul.comm
+      ... = 1 : div_self (division_ring.mul_ne_zero Ha Hb),
+    symm (eq_one_div_of_mul_eq_one this)
+  -/
+
+  theorem field.div_div_eq_mul_div (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
+      a / (b / c) = (a * c) / b :=
+  sorry --  by rewrite [div_eq_mul_one_div, (field.one_div_div Hb Hc), -mul_div_assoc]
+
+  theorem field.div_div_eq_div_mul (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
+      (a / b) / c = a / (b * c) :=
+  sorry -- by rewrite [div_eq_mul_one_div, (!field.div_mul_div Hb Hc), mul_one]
+
+  theorem field.div_div_div_div_eq (a : A) {b c d : A} (Hb : b ≠ 0) (Hc : c ≠ 0) (Hd : d ≠ 0) :
+       (a / b) / (c / d) = (a * d) / (b * c) :=
+  sorry
+  /-
+    by rewrite [(!field.div_div_eq_mul_div Hc Hd), (div_mul_eq_mul_div),
+                (!field.div_div_eq_div_mul Hb Hc)]
+  -/
+  theorem field.div_mul_eq_div_mul_one_div (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
+      a / (b * c) = (a / b) * (1 / c) :=
+  sorry -- by rewrite [-!field.div_div_eq_div_mul Hb Hc, -div_eq_mul_one_div]
+
+  theorem eq_of_mul_eq_mul_of_nonzero_left {a b c : A} (H : a ≠ 0) (H2 : a * b = a * c) : b = c :=
+  sorry -- by rewrite [-one_mul b, -div_self H, div_mul_eq_mul_div, H2, mul_div_cancel_left H]
+
+  theorem eq_of_mul_eq_mul_of_nonzero_right {a b c : A} (H : c ≠ 0) (H2 : a * c = b * c) : a = b :=
+  sorry -- by rewrite [-mul_one a, -div_self H, -mul_div_assoc, H2, mul_div_cancel _ H]
+
+end field
+
+structure discrete_field [class] (A : Type) extends field A :=
+  (has_decidable_eq : decidable_eq A)
+  (inv_zero : inv zero = zero)
+
+attribute discrete_field.has_decidable_eq [instance]
+
+section discrete_field
+  variable [s : discrete_field A]
+  include s
+  variables {a b c d : A}
+
+  -- many of the theorems in discrete_field are the same as theorems in field or division ring,
+  -- but with fewer hypotheses since 0⁻¹ = 0 and equality is decidable.
+
+  theorem discrete_field.eq_zero_or_eq_zero_of_mul_eq_zero
+    (x y : A) (H : x * y = 0) : x = 0 ∨ y = 0 :=
+  sorry
+  /-
+  decidable.by_cases
+    (suppose x = 0, or.inl this)
+    (suppose x ≠ 0,
+      or.inr (by rewrite [-one_mul, -(inv_mul_cancel this), mul.assoc, H, mul_zero]))
+  -/
+
+  attribute [instance]
+  definition discrete_field.to_integral_domain :
+    integral_domain A :=
+  ⦃ integral_domain, s,
+    eq_zero_or_eq_zero_of_mul_eq_zero := discrete_field.eq_zero_or_eq_zero_of_mul_eq_zero⦄
+
+  theorem inv_zero : 0⁻¹ = (0:A) := discrete_field.inv_zero A
+
+  theorem one_div_zero : 1 / 0 = (0:A) :=
+  sorry
+  /-
+    calc
+      1 / 0 = 1 * 0⁻¹ : rfl
+        ... = 1 * 0   : by rewrite inv_zero
+        ... = 0       : by rewrite mul_zero
+  -/
+
+  theorem div_zero (a : A) : a / 0 = 0 :=
+  sorry -- by rewrite [div_eq_mul_one_div, one_div_zero, mul_zero]
+
+  theorem ne_zero_of_one_div_ne_zero (H : 1 / a ≠ 0) : a ≠ 0 :=
+    assume Ha : a = 0, absurd (symm Ha ▸ one_div_zero) H
+
+  theorem eq_zero_of_one_div_eq_zero (H : 1 / a = 0) : a = 0 :=
+    decidable.by_cases
+      (assume Ha, Ha)
+      (assume Ha, false.elim ((one_div_ne_zero Ha) H))
+
+  variables (a b)
+  theorem one_div_mul_one_div' : (1 / a) * (1 / b) = 1 / (b * a) :=
+  sorry
+  /-
+    decidable.by_cases
+      (suppose a = 0,
+        by rewrite [this, div_zero, zero_mul, -(@div_zero A s 1), mul_zero b])
+      (assume Ha : a ≠ 0,
+        decidable.by_cases
+          (suppose b = 0,
+            by rewrite [this, div_zero, mul_zero, -(@div_zero A s 1), zero_mul a])
+          (suppose b ≠ 0, division_ring.one_div_mul_one_div Ha this))
+  -/
+
+  theorem one_div_neg_eq_neg_one_div : 1 / (- a) = - (1 / a) :=
+  sorry
+  /-
+    decidable.by_cases
+      (suppose a = 0, by rewrite [this, neg_zero, 2 div_zero, neg_zero])
+      (suppose a ≠ 0, division_ring.one_div_neg_eq_neg_one_div this)
+  -/
+
+  theorem neg_div_neg_eq : (-a) / (-b) = a / b :=
+  sorry
+  /-
+    decidable.by_cases
+      (assume Hb : b = 0, by rewrite [Hb, neg_zero, 2 div_zero])
+      (assume Hb : b ≠ 0, !division_ring.neg_div_neg_eq Hb)
+  -/
+
+  theorem one_div_one_div : 1 / (1 / a) = a :=
+  sorry
+  /-
+    decidable.by_cases
+      (assume Ha : a = 0, by rewrite [Ha, 2 div_zero])
+      (assume Ha : a ≠ 0, division_ring.one_div_one_div Ha)
+  -/
+
+  variables {a b}
+  theorem eq_of_one_div_eq_one_div (H : 1 / a = 1 / b) : a = b :=
+  sorry
+  /-
+    decidable.by_cases
+      (assume Ha : a = 0,
+      have Hb : b = 0, from eq_zero_of_one_div_eq_zero (by rewrite [-H, Ha, div_zero]),
+      Hb⁻¹ ▸ Ha)
+      (assume Ha : a ≠ 0,
+      have Hb : b ≠ 0, from ne_zero_of_one_div_ne_zero (H ▸ (one_div_ne_zero Ha)),
+      division_ring.eq_of_one_div_eq_one_div Ha Hb H)
+  -/
+
+  variables (a b)
+  theorem mul_inv' : (b * a)⁻¹ = a⁻¹ * b⁻¹ :=
+  sorry
+  /-
+    decidable.by_cases
+      (assume Ha : a = 0, by rewrite [Ha, mul_zero, 2 inv_zero, zero_mul])
+      (assume Ha : a ≠ 0,
+        decidable.by_cases
+          (assume Hb : b = 0, by rewrite [Hb, zero_mul, 2 inv_zero, mul_zero])
+          (assume Hb : b ≠ 0, mul_inv_eq Ha Hb))
+  -/
+
+-- the following are specifically for fields
+  theorem one_div_mul_one_div : (1 / a) * (1 / b) =  1 / (a * b) :=
+  sorry --   by rewrite [one_div_mul_one_div', mul.comm b]
+
+  variable {a}
+  theorem div_mul_right (Ha : a ≠ 0) : a / (a * b) = 1 / b :=
+  sorry
+  /-
+    decidable.by_cases
+      (assume Hb : b = 0, by rewrite [Hb, mul_zero, 2 div_zero])
+      (assume Hb : b ≠ 0, field.div_mul_right Hb (mul_ne_zero Ha Hb))
+  -/
+
+  variables (a) {b}
+  theorem div_mul_left (Hb : b ≠ 0) : b / (a * b) = 1 / a :=
+  sorry -- by rewrite [mul.comm a, div_mul_right _ Hb]
+
+  variables (a b c)
+  theorem div_mul_div : (a / b) * (c / d) = (a * c) / (b * d) :=
+  sorry
+  /-
+    decidable.by_cases
+      (assume Hb : b = 0, by rewrite [Hb, div_zero, zero_mul, -(@div_zero A s (a * c)), zero_mul])
+      (assume Hb : b ≠ 0,
+        decidable.by_cases
+          (assume Hd : d = 0, by rewrite [Hd, div_zero, mul_zero, -(@div_zero A s (a * c)),
+                                          mul_zero])
+          (assume Hd : d ≠ 0, !field.div_mul_div Hb Hd))
+  -/
+
+  variable {c}
+  theorem mul_div_mul_left' (Hc : c ≠ 0) : (c * a) / (c * b) = a / b :=
+  sorry
+  /-
+    decidable.by_cases
+      (assume Hb : b = 0, by rewrite [Hb, mul_zero, 2 div_zero])
+      (assume Hb : b ≠ 0, !mul_div_mul_left Hb Hc)
+  -/
+
+  theorem mul_div_mul_right' (Hc : c ≠ 0) : (a * c) / (b * c) = a / b :=
+  sorry -- by rewrite [(mul.comm a), (mul.comm b), (!mul_div_mul_left' Hc)]
+
+  variables (a b c d)
+  theorem div_mul_eq_mul_div_comm : (b / c) * a = b * (a / c) :=
+  sorry
+  /-
+    decidable.by_cases
+      (assume Hc : c = 0, by rewrite [Hc, div_zero, zero_mul, -(mul_zero b), -(@div_zero A s a)])
+      (assume Hc : c ≠ 0, !field.div_mul_eq_mul_div_comm Hc)
+  -/
+
+  theorem one_div_div : 1 / (a / b) = b / a :=
+  sorry
+  /-
+    decidable.by_cases
+      (assume Ha : a = 0, by rewrite [Ha, zero_div, 2 div_zero])
+      (assume Ha : a ≠ 0,
+      decidable.by_cases
+        (assume Hb : b = 0, by rewrite [Hb, 2 div_zero, zero_div])
+        (assume Hb : b ≠ 0, field.one_div_div Ha Hb))
+  -/
+
+  theorem div_div_eq_mul_div : a / (b / c) = (a * c) / b :=
+  sorry --  by rewrite [div_eq_mul_one_div, one_div_div, -mul_div_assoc]
+
+  theorem div_div_eq_div_mul : (a / b) / c = a / (b * c) :=
+  sorry -- by rewrite [div_eq_mul_one_div, div_mul_div, mul_one]
+
+  theorem div_div_div_div_eq : (a / b) / (c / d) = (a * d) / (b * c) :=
+  sorry -- by rewrite [div_div_eq_mul_div, div_mul_eq_mul_div, div_div_eq_div_mul]
+
+  variable {a}
+  theorem div_helper (H : a ≠ 0) : (1 / (a * b)) * a = 1 / b :=
+  sorry -- by rewrite [div_mul_eq_mul_div, one_mul, !div_mul_right H]
+
+  variable (a)
+  theorem div_mul_eq_div_mul_one_div : a / (b * c) = (a / b) * (1 / c) :=
+  sorry -- by rewrite [-div_div_eq_div_mul, -div_eq_mul_one_div]
+
+end discrete_field
+
+namespace norm_num
+
+theorem div_add_helper [s : field A] (n d b c val : A) (Hd : d ≠ 0) (H : n + b * d = val)
+        (H2 : c * d = val) : n / d + b = c :=
+sorry
+/-
+  begin
+    apply eq_of_mul_eq_mul_of_nonzero_right Hd,
+    rewrite [H2, -H, right_distrib, div_mul_cancel _ Hd]
+ end
+-/
+
+theorem add_div_helper [s : field A] (n d b c val : A) (Hd : d ≠ 0) (H : d * b + n = val)
+        (H2 : d * c = val) : b + n / d = c :=
+sorry
+/-
+  begin
+    apply eq_of_mul_eq_mul_of_nonzero_left Hd,
+    rewrite [H2, -H, left_distrib, mul_div_cancel' Hd]
+ end
+-/
+theorem div_mul_helper [s : field A] (n d c v : A) (Hd : d ≠ 0) (H : (n * c) / d = v) :
+        (n / d) * c = v :=
+sorry -- by rewrite [-H, field.div_mul_eq_mul_div_comm _ _ Hd, mul_div_assoc]
+
+theorem mul_div_helper [s : field A] (a n d v : A) (Hd : d ≠ 0) (H : (a * n) / d = v) :
+        a * (n / d) = v :=
+sorry --  by rewrite [-H, mul_div_assoc]
+
+theorem nonzero_of_div_helper [s : field A] (a b : A) (Ha : a ≠ 0) (Hb : b ≠ 0) : a / b ≠ 0 :=
+sorry
+/-
+  begin
+    intro Hab,
+    have Habb : (a / b) * b = 0, by rewrite [Hab, zero_mul],
+    rewrite [div_mul_cancel _ Hb at Habb],
+    exact Ha Habb
+  end
+-/
+
+theorem div_helper [s : field A] (n d v : A) (Hd : d ≠ 0) (H : v * d = n) : n / d = v :=
+sorry
+/-
+  begin
+    apply eq_of_mul_eq_mul_of_nonzero_right Hd,
+    rewrite (div_mul_cancel _ Hd),
+    exact eq.symm H
+  end
+-/
+
+theorem div_eq_div_helper [s : field A] (a b c d v : A) (H1 : a * d = v) (H2 : c * b = v)
+        (Hb : b ≠ 0) (Hd : d ≠ 0) : a / b = c / d :=
+sorry
+/-
+  begin
+    apply eq_div_of_mul_eq,
+    exact Hd,
+    rewrite div_mul_eq_mul_div,
+    apply eq.symm,
+    apply eq_div_of_mul_eq,
+    exact Hb,
+    rewrite [H1, H2]
+  end
+-/
+
+theorem subst_into_div [s : has_div A] (a₁ b₁ a₂ b₂ v : A) (H : a₁ / b₁ = v) (H1 : a₂ = a₁)
+        (H2 : b₂ = b₁) : a₂ / b₂ = v :=
+sorry -- by rewrite [H1, H2, H]
+
+end norm_num

old_library/algebra/galois_connection.lean

@@ -0,0 +1,217 @@
+/-
+Copyright (c) 2016 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Johannes Hölzl
+
+Galois connections - order theoretic adjoints.
+-/
+import standard
+local attribute classical.prop_decidable [instance] eq.ops algebra set function complete_lattice
+
+/- Move to set? -/
+definition kern_image {X Y : Type} (f : X → Y) (S : set X) : set Y := {y | ∀x, f x = y → x ∈ S }
+
+/- Order theoretic definitions -/
+
+/- TODO: move to order? -/
+section order
+variables {A B : Type} {S : set A} {a a' : A} {b b' : B} {f : A → B} [weak_order A] [weak_order B]
+
+definition increasing (f : A → A) := ∀⦃a⦄, a ≤ f a
+definition decreasing (f : A → A) := ∀⦃a⦄, f a ≤ a
+
+definition upper_bounds (S : set A) : set A := { x | ∀₀ s ∈ S, s ≤ x }
+definition lower_bounds (S : set A) : set A := { x | ∀₀ s ∈ S, x ≤ s }
+definition is_least (S : set A) (a : A) := a ∈ S ∧ a ∈ lower_bounds S
+definition is_greatest (S : set A) (a : A) := a ∈ S ∧ a ∈ upper_bounds S
+
+definition monotone (f : A → B) := ∀⦃a b⦄, a ≤ b → f a ≤ f b
+
+lemma eq_of_is_least_of_is_least (Ha : is_least S a) (Hb : is_least S a') : a = a' :=
+le.antisymm
+  begin apply (and.elim_right Ha), apply (and.elim_left Hb) end
+  begin apply (and.elim_right Hb), apply (and.elim_left Ha) end
+
+lemma is_least_iff_eq_of_is_least (Ha : is_least S a) : is_least S a' ↔ a = a' :=
+iff.intro (eq_of_is_least_of_is_least Ha) begin intro H, cases H, apply Ha end
+
+lemma eq_of_is_greatest_of_is_greatest (Ha : is_greatest S a) (Hb : is_greatest S a') : a = a' :=
+le.antisymm
+  begin apply (and.elim_right Hb), apply (and.elim_left Ha) end
+  begin apply (and.elim_right Ha), apply (and.elim_left Hb) end
+
+lemma is_greatest_iff_eq_of_is_greatest (Ha : is_greatest S a) : is_greatest S a' ↔ a = a' :=
+iff.intro (eq_of_is_greatest_of_is_greatest Ha) begin intro H, cases H, apply Ha end
+
+definition is_lub (S : set A) := is_least (upper_bounds S)
+definition is_glb (S : set A) := is_greatest (lower_bounds S)
+
+lemma eq_of_is_lub_of_is_lub : is_lub S a → is_lub S a' → a = a' :=
+!eq_of_is_least_of_is_least
+
+lemma is_lub_iff_eq_of_is_lub : is_lub S a → (is_lub S a' ↔ a = a') :=
+!is_least_iff_eq_of_is_least
+
+lemma eq_of_is_glb_of_is_glb : is_glb S a → is_glb S a' → a = a' :=
+!eq_of_is_greatest_of_is_greatest
+
+lemma is_glb_iff_eq_of_is_glb : is_glb S a → (is_glb S a' ↔ a = a') :=
+!is_greatest_iff_eq_of_is_greatest
+
+lemma mem_upper_bounds_image (Hf : monotone f) (Ha : a ∈ upper_bounds S) : f a ∈ upper_bounds (f ' S) :=
+bounded_forall_image_of_bounded_forall (take x H, Hf (Ha `x ∈ S`))
+
+lemma mem_lower_bounds_image (Hf : monotone f) (Ha : a ∈ lower_bounds S) : f a ∈ lower_bounds (f ' S) :=
+bounded_forall_image_of_bounded_forall (take x H, Hf (Ha `x ∈ S`))
+
+end order
+
+definition galois_connection {A B : Type} [weak_order A] [weak_order B] (l : A → B) (u : B → A) :=
+  ∀{a b}, l a ≤ b ↔ a ≤ u b
+
+namespace galois_connection
+
+section
+parameters {A B : Type} [weak_order A] [weak_order B] (l : A → B) (u : B → A)
+
+lemma monotone_intro (Mu : monotone u) (Ml : monotone l)
+    (Iul : increasing (u ∘ l)) (Dlu : decreasing (l ∘ u)) : galois_connection l u :=
+begin
+  intros a b,
+  apply iff.intro,
+  { intro H, apply le.trans, apply Iul, apply Mu, assumption },
+  { intro H, apply le.trans, apply Ml, assumption, apply Dlu }
+end
+
+parameter (gc : galois_connection l u)
+include gc
+
+lemma l_le {a : A} {b : B} : a ≤ u b → l a ≤ b :=
+and.elim_right !gc
+
+lemma le_u {a : A} {b : B} : l a ≤ b → a ≤ u b :=
+and.elim_left !gc
+
+lemma increasing_u_l : increasing (u ∘ l) :=
+take a, le_u !le.refl
+
+lemma decreasing_l_u : decreasing (l ∘ u) :=
+take a, l_le !le.refl
+
+lemma monotone_u : monotone u :=
+take a b H, le_u (le.trans !decreasing_l_u H)
+
+lemma monotone_l : monotone l :=
+take a b H, l_le (le.trans H !increasing_u_l)
+
+lemma u_l_u_eq_u : u ∘ l ∘ u = u :=
+funext (take x, le.antisymm (monotone_u !decreasing_l_u) !increasing_u_l)
+
+lemma l_u_l_eq_l : l ∘ u ∘ l = l :=
+funext (take x, le.antisymm !decreasing_l_u (monotone_l !increasing_u_l))
+
+lemma u_mem_upper_bounds {S : set A} {b : B} (H : b ∈ upper_bounds (l ' S)) : u b ∈ upper_bounds S :=
+take c, suppose c ∈ S, le_u (H (!mem_image_of_mem `c ∈ S`))
+
+lemma l_mem_lower_bounds {S : set B} {a : A} (H : a ∈ lower_bounds (u ' S)) : l a ∈ lower_bounds S :=
+take c, suppose c ∈ S, l_le (H (!mem_image_of_mem `c ∈ S`))
+
+lemma is_lub_l_image {S : set A} {a : A} (H : is_lub S a) : is_lub (l ' S) (l a) :=
+and.intro
+  (mem_upper_bounds_image monotone_l (and.elim_left `is_lub S a`))
+  (take b Hb, l_le (and.elim_right `is_lub S a` _ (u_mem_upper_bounds Hb)))
+
+lemma is_glb_u_image {S : set B} {b : B} (H : is_glb S b) : is_glb (u ' S) (u b) :=
+and.intro
+  (mem_lower_bounds_image monotone_u (and.elim_left `is_glb S b`))
+  (take a Ha, le_u (and.elim_right `is_glb S b` _ (l_mem_lower_bounds Ha)))
+
+lemma is_glb_l {a : A} : is_glb { b | a ≤ u b } (l a) :=
+begin
+  apply and.intro,
+  { intro b, apply l_le },
+  { intro b H, apply H, apply increasing_u_l }
+end
+
+lemma is_lub_u {b : B} : is_lub { a | l a ≤ b } (u b) :=
+begin
+  apply and.intro,
+  { intro a, apply le_u },
+  { intro a H, apply H, apply decreasing_l_u }
+end
+
+end
+
+/- Constructing Galois connections -/
+
+protected lemma id {A : Type} [weak_order A] : @galois_connection A A _ _ id id :=
+take a b, iff.intro (λx, x) (λx, x)
+
+protected lemma dual {A B : Type} [woA : weak_order A] [woB : weak_order B]
+  (l : A → B) (u : B → A) (gc : galois_connection l u) :
+  @galois_connection B A (weak_order_dual woB) (weak_order_dual woA) u l :=
+take a b,
+begin
+  apply iff.symm,
+  rewrite le_dual_eq_le,
+  rewrite le_dual_eq_le,
+  exact gc,
+end
+
+protected lemma compose {A B C : Type} [weak_order A] [weak_order B] [weak_order C]
+  (l1 : A → B) (u1 : B → A) (l2 : B → C) (u2 : C → B)
+  (gc1 : galois_connection l1 u1) (gc2 : galois_connection l2 u2) :
+  galois_connection (l2 ∘ l1) (u1 ∘ u2) :=
+by intros; rewrite gc2; rewrite gc1
+
+section
+  variables {A B : Type} {f : A → B}
+
+  protected lemma image_preimage : galois_connection (image f) (preimage f) :=
+    @image_subset_iff A B f
+
+  protected lemma preimage_kern_image : galois_connection (preimage f) (kern_image f) :=
+  begin
+    intros X Y, apply iff.intro, all_goals (intro H x Hx),
+    { intro x' eq, apply H, cases eq, exact Hx },
+    { apply H,
+      esimp [preimage, mem, set_of] at Hx, exact Hx, -- TODO: why is esimp necessary?
+      exact rfl }
+  end
+end
+
+end galois_connection
+
+/- Bounds on complete lattices -/
+/- TODO: move to complete lattices? -/
+
+section
+variables {A : Type} (S : set A) {a b : A} [complete_lattice A]
+
+lemma is_lub_sup : is_lub '{a, b} (sup a b) :=
+and.intro
+  begin
+    xrewrite [+bounded_forall_insert_iff, bounded_forall_empty_iff, and_true],
+    exact (and.intro !le_sup_left !le_sup_right)
+  end
+  begin
+    intro x Hx,
+    xrewrite [+bounded_forall_insert_iff at Hx, bounded_forall_empty_iff at Hx, and_true at Hx],
+    apply sup_le,
+    apply (and.elim_left Hx),
+    apply (and.elim_right Hx),
+  end
+
+lemma is_lub_Sup : is_lub S (⨆S) :=
+and.intro (take x, le_Sup) (take x, Sup_le)
+
+lemma is_lub_iff_Sup_eq {a : A} : is_lub S a ↔ (⨆S) = a :=
+!is_lub_iff_eq_of_is_lub !is_lub_Sup
+
+lemma is_glb_Inf : is_glb S (⨅S) :=
+and.intro (take a, Inf_le) (take a, le_Inf)
+
+lemma is_glb_iff_Inf_eq : is_glb S a ↔ (⨅S) = a :=
+!is_glb_iff_eq_of_is_glb !is_glb_Inf
+
+end

old_library/algebra/group.lean

@@ -0,0 +1,807 @@
+/-
+Copyright (c) 2014 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad, Leonardo de Moura
+
+Various multiplicative and additive structures. Partially modeled on Isabelle's library.
+-/
+import logic.eq data.sigma data.prod
+import algebra.binary algebra.priority
+
+open binary
+
+variable {A : Type}
+
+/- semigroup -/
+
+/- TODO(Leo): decide whether we keep this annotation or not -/
+-- attribute inv [light 3]
+-- attribute neg [light 3]
+
+structure semigroup [class] (A : Type) extends has_mul A :=
+(mul_assoc : ∀a b c : A, a * b * c = a * (b * c))
+
+-- We add pattern hints to the following lemma because we want it to be used in both directions
+-- at inst_simp strategy.
+attribute [simp]
+theorem mul.assoc [semigroup A] (a b c : A) : a * b * c = a * (b * c) :=
+semigroup.mul_assoc a b c
+
+set_option pp.all true
+structure comm_semigroup [class] (A : Type) extends semigroup A :=
+(mul_comm : ∀a b : A, a * b = b * a)
+
+attribute [simp]
+theorem mul.comm [comm_semigroup A] (a b : A) : a * b = b * a :=
+comm_semigroup.mul_comm a b
+
+attribute [simp]
+theorem mul.left_comm [comm_semigroup A] (a b c : A) : a * (b * c) = b * (a * c) :=
+binary.left_comm (@mul.comm A _) (@mul.assoc A _) a b c
+
+theorem mul.right_comm [comm_semigroup A] (a b c : A) : (a * b) * c = (a * c) * b :=
+sorry -- by simp
+
+structure left_cancel_semigroup [class] (A : Type) extends semigroup A :=
+(mul_left_cancel : ∀a b c : A, a * b = a * c → b = c)
+
+theorem mul.left_cancel [left_cancel_semigroup A] {a b c : A} : a * b = a * c → b = c :=
+left_cancel_semigroup.mul_left_cancel a b c
+
+abbreviation eq_of_mul_eq_mul_left' := @mul.left_cancel
+
+structure right_cancel_semigroup [class] (A : Type) extends semigroup A :=
+(mul_right_cancel : ∀a b c : A, a * b = c * b → a = c)
+
+theorem mul.right_cancel [right_cancel_semigroup A] {a b c : A} : a * b = c * b → a = c :=
+right_cancel_semigroup.mul_right_cancel a b c
+
+abbreviation eq_of_mul_eq_mul_right' := @mul.right_cancel
+
+/- additive semigroup -/
+
+structure add_semigroup [class] (A : Type) extends has_add A :=
+(add_assoc : ∀a b c : A, a + b + c = a + (b + c))
+
+attribute [simp]
+theorem add.assoc [add_semigroup A] (a b c : A) : a + b + c = a + (b + c) :=
+add_semigroup.add_assoc a b c
+
+structure add_comm_semigroup [class] (A : Type) extends add_semigroup A :=
+(add_comm : ∀a b : A, a + b = b + a)
+
+attribute [simp]
+theorem add.comm [add_comm_semigroup A] (a b : A) : a + b = b + a :=
+add_comm_semigroup.add_comm a b
+
+attribute [simp]
+theorem add.left_comm [add_comm_semigroup A] (a b c : A) : a + (b + c) = b + (a + c) :=
+binary.left_comm (@add.comm A _) (@add.assoc A _) a b c
+
+theorem add.right_comm [add_comm_semigroup A] (a b c : A) : (a + b) + c = (a + c) + b :=
+sorry -- by simp
+
+structure add_left_cancel_semigroup [class] (A : Type) extends add_semigroup A :=
+(add_left_cancel : ∀a b c : A, a + b = a + c → b = c)
+
+theorem add.left_cancel [add_left_cancel_semigroup A] {a b c : A} : a + b = a + c → b = c :=
+add_left_cancel_semigroup.add_left_cancel a b c
+
+abbreviation eq_of_add_eq_add_left := @add.left_cancel
+
+structure add_right_cancel_semigroup [class] (A : Type) extends add_semigroup A :=
+(add_right_cancel : ∀a b c : A, a + b = c + b → a = c)
+
+theorem add.right_cancel [add_right_cancel_semigroup A] {a b c : A} : a + b = c + b → a = c :=
+add_right_cancel_semigroup.add_right_cancel a b c
+
+abbreviation eq_of_add_eq_add_right := @add.right_cancel
+
+/- monoid -/
+
+structure monoid [class] (A : Type) extends semigroup A, has_one A :=
+(one_mul : ∀a : A, 1 * a = a) (mul_one : ∀a : A, a * 1 = a)
+
+attribute [simp]
+theorem one_mul [monoid A] (a : A) : 1 * a = a := monoid.one_mul a
+
+attribute [simp]
+theorem mul_one [monoid A] (a : A) : a * 1 = a := monoid.mul_one a
+
+structure comm_monoid [class] (A : Type) extends monoid A, comm_semigroup A
+
+/- additive monoid -/
+
+structure add_monoid [class] (A : Type) extends add_semigroup A, has_zero A :=
+(zero_add : ∀a : A, 0 + a = a) (add_zero : ∀a : A, a + 0 = a)
+
+attribute [simp]
+theorem zero_add [add_monoid A] (a : A) : 0 + a = a := add_monoid.zero_add a
+
+attribute [simp]
+theorem add_zero [add_monoid A] (a : A) : a + 0 = a := add_monoid.add_zero a
+
+structure add_comm_monoid [class] (A : Type) extends add_monoid A, add_comm_semigroup A
+
+definition add_monoid.to_monoid {A : Type} [add_monoid A] : monoid A :=
+⦃ monoid,
+  mul         := add_monoid.add,
+  mul_assoc   := add_monoid.add_assoc,
+  one         := add_monoid.zero A,
+  mul_one     := add_monoid.add_zero,
+  one_mul     := add_monoid.zero_add
+⦄
+
+definition add_comm_monoid.to_comm_monoid {A : Type} [add_comm_monoid A] : comm_monoid A :=
+⦃ comm_monoid,
+  add_monoid.to_monoid,
+  mul_comm    := add_comm_monoid.add_comm
+⦄
+
+section add_comm_monoid
+  variables [add_comm_monoid A]
+
+  theorem add_comm_three  (a b c : A) : a + b + c = c + b + a :=
+  sorry -- by simp
+
+  theorem add.comm4 : ∀ (n m k l : A), n + m + (k + l) = n + k + (m + l) :=
+  sorry -- by simp
+end add_comm_monoid
+
+/- group -/
+
+structure group [class] (A : Type) extends monoid A, has_inv A :=
+(mul_left_inv : ∀a : A, a⁻¹ * a = 1)
+
+-- Note: with more work, we could derive the axiom one_mul
+
+section group
+  variable [group A]
+
+  attribute [simp]
+  theorem mul.left_inv (a : A) : a⁻¹ * a = 1 := group.mul_left_inv a
+
+  attribute [simp]
+  theorem inv_mul_cancel_left (a b : A) : a⁻¹ * (a * b) = b :=
+  sorry -- by rewrite [-mul.assoc, mul.left_inv, one_mul]
+
+  attribute [simp]
+  theorem inv_mul_cancel_right (a b : A) : a * b⁻¹ * b = a :=
+  sorry -- by simp
+
+  theorem inv_eq_of_mul_eq_one {a b : A} (H : a * b = 1) : a⁻¹ = b :=
+  sorry
+  /-
+  have a⁻¹ * 1 = b, by inst_simp,
+  by inst_simp
+  -/
+
+  attribute [simp]
+  theorem one_inv : 1⁻¹ = (1 : A) :=
+  inv_eq_of_mul_eq_one (one_mul 1)
+
+  attribute [simp]
+  theorem inv_inv (a : A) : (a⁻¹)⁻¹ = a :=
+  inv_eq_of_mul_eq_one (mul.left_inv a)
+
+  variable (A)
+  theorem left_inverse_inv : function.left_inverse (λ a : A, a⁻¹) (λ a, a⁻¹) :=
+  take a, inv_inv a
+  variable {A}
+
+  theorem inv.inj {a b : A} (H : a⁻¹ = b⁻¹) : a = b :=
+  sorry
+  /-
+  have a = a⁻¹⁻¹, by simp_nohyps,
+  by inst_simp
+  -/
+
+  theorem inv_eq_inv_iff_eq (a b : A) : a⁻¹ = b⁻¹ ↔ a = b :=
+  sorry -- iff.intro (assume H, inv.inj H) (by simp)
+
+  theorem inv_eq_one_iff_eq_one (a : A) : a⁻¹ = 1 ↔ a = 1 :=
+  sorry
+  /-
+  have a⁻¹ = 1⁻¹ ↔ a = 1, from inv_eq_inv_iff_eq a 1,
+  by simp
+  -/
+
+  theorem eq_one_of_inv_eq_one (a : A) : a⁻¹ = 1 → a = 1 :=
+  iff.mp (inv_eq_one_iff_eq_one a)
+
+  theorem eq_inv_of_eq_inv {a b : A} (H : a = b⁻¹) : b = a⁻¹ :=
+  sorry -- by simp
+
+  theorem eq_inv_iff_eq_inv (a b : A) : a = b⁻¹ ↔ b = a⁻¹ :=
+  iff.intro eq_inv_of_eq_inv eq_inv_of_eq_inv
+
+  theorem eq_inv_of_mul_eq_one {a b : A} (H : a * b = 1) : a = b⁻¹ :=
+  sorry
+  /-
+  have a⁻¹ = b, from inv_eq_of_mul_eq_one H,
+  by inst_simp
+  -/
+
+  attribute [simp]
+  theorem mul.right_inv (a : A) : a * a⁻¹ = 1 :=
+  sorry
+  /-
+  have a = a⁻¹⁻¹, by simp,
+  by inst_simp
+  -/
+
+  attribute [simp]
+  theorem mul_inv_cancel_left (a b : A) : a * (a⁻¹ * b) = b :=
+  sorry -- by inst_simp
+
+  attribute [simp]
+  theorem mul_inv_cancel_right (a b : A) : a * b * b⁻¹ = a :=
+  sorry -- by inst_simp
+
+  attribute [simp]
+  theorem mul_inv (a b : A) : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
+  sorry -- inv_eq_of_mul_eq_one (by inst_simp)
+
+  theorem eq_of_mul_inv_eq_one {a b : A} (H : a * b⁻¹ = 1) : a = b :=
+  sorry
+  /-
+  have a⁻¹ * 1 = a⁻¹, by inst_simp,
+  by inst_simp
+  -/
+
+  theorem eq_mul_inv_of_mul_eq {a b c : A} (H : a * c = b) : a = b * c⁻¹ :=
+  sorry -- by simp
+
+  theorem eq_inv_mul_of_mul_eq {a b c : A} (H : b * a = c) : a = b⁻¹ * c :=
+  sorry -- by simp
+
+  theorem inv_mul_eq_of_eq_mul {a b c : A} (H : b = a * c) : a⁻¹ * b = c :=
+  sorry -- by simp
+
+  theorem mul_inv_eq_of_eq_mul {a b c : A} (H : a = c * b) : a * b⁻¹ = c :=
+  sorry -- by simp
+
+  theorem eq_mul_of_mul_inv_eq {a b c : A} (H : a * c⁻¹ = b) : a = b * c :=
+  sorry -- by simp
+
+  theorem eq_mul_of_inv_mul_eq {a b c : A} (H : b⁻¹ * a = c) : a = b * c :=
+  sorry -- by simp
+
+  theorem mul_eq_of_eq_inv_mul {a b c : A} (H : b = a⁻¹ * c) : a * b = c :=
+  sorry -- by simp
+
+  theorem mul_eq_of_eq_mul_inv {a b c : A} (H : a = c * b⁻¹) : a * b = c :=
+  sorry -- by simp
+
+  theorem mul_eq_iff_eq_inv_mul (a b c : A) : a * b = c ↔ b = a⁻¹ * c :=
+  iff.intro eq_inv_mul_of_mul_eq mul_eq_of_eq_inv_mul
+
+  theorem mul_eq_iff_eq_mul_inv (a b c : A) : a * b = c ↔ a = c * b⁻¹ :=
+  iff.intro eq_mul_inv_of_mul_eq mul_eq_of_eq_mul_inv
+
+  theorem mul_left_cancel {a b c : A} (H : a * b = a * c) : b = c :=
+  sorry
+  /-
+  have a⁻¹ * (a * b) = b, by inst_simp,
+  by inst_simp
+  -/
+
+  theorem mul_right_cancel {a b c : A} (H : a * b = c * b) : a = c :=
+  sorry
+  /-
+  have a * b * b⁻¹ = a, by inst_simp,
+  by inst_simp
+  -/
+
+  theorem mul_eq_one_of_mul_eq_one {a b : A} (H : b * a = 1) : a * b = 1 :=
+  sorry -- by rewrite [-inv_eq_of_mul_eq_one H, mul.left_inv]
+
+  theorem mul_eq_one_iff_mul_eq_one (a b : A) : a * b = 1 ↔ b * a = 1 :=
+  iff.intro mul_eq_one_of_mul_eq_one mul_eq_one_of_mul_eq_one
+
+  definition conj_by (g a : A) := g * a * g⁻¹
+  definition is_conjugate (a b : A) := ∃ x, conj_by x b = a
+
+  local infixl ` ~ ` := is_conjugate
+  local infixr ` ∘c `:55 := conj_by
+
+  local attribute conj_by [reducible]
+
+  attribute [simp]
+  lemma conj_compose (f g a : A) : f ∘c g ∘c a = f*g ∘c a :=
+  sorry -- by inst_simp
+
+  attribute [simp]
+  lemma conj_id (a : A) : 1 ∘c a = a :=
+  sorry -- by inst_simp
+
+  attribute [simp]
+  lemma conj_one (g : A) : g ∘c 1 = 1 :=
+  sorry -- by inst_simp
+
+  attribute [simp]
+  lemma conj_inv_cancel (g : A) : ∀ a, g⁻¹ ∘c g ∘c a = a :=
+  sorry -- by inst_simp
+
+  attribute [simp]
+  lemma conj_inv (g : A) : ∀ a, (g ∘c a)⁻¹ = g ∘c a⁻¹ :=
+  sorry -- by inst_simp
+
+  lemma is_conj.refl (a : A) : a ~ a := exists.intro 1 (conj_id a)
+
+  lemma is_conj.symm (a b : A) : a ~ b → b ~ a :=
+  sorry
+  /-
+  assume Pab, obtain x (Pconj : x ∘c b = a), from Pab,
+  have Pxinv : x⁻¹ ∘c x ∘c b = x⁻¹ ∘c a,   by simp,
+  exists.intro x⁻¹ (by simp)
+  -/
+
+  lemma is_conj.trans (a b c : A) : a ~ b → b ~ c → a ~ c :=
+  sorry
+  /-
+  assume Pab, assume Pbc,
+  obtain x (Px : x ∘c b = a), from Pab,
+  obtain y (Py : y ∘c c = b), from Pbc,
+  exists.intro (x*y) (by inst_simp)
+  -/
+
+end group
+
+attribute [instance]
+definition group.to_left_cancel_semigroup [s : group A] :
+    left_cancel_semigroup A :=
+⦃ left_cancel_semigroup, s,
+  mul_left_cancel := @mul_left_cancel A s ⦄
+
+attribute [instance]
+definition group.to_right_cancel_semigroup [s : group A] :
+    right_cancel_semigroup A :=
+⦃ right_cancel_semigroup, s,
+  mul_right_cancel := @mul_right_cancel A s ⦄
+
+structure comm_group [class] (A : Type) extends group A, comm_monoid A
+
+/- additive group -/
+
+structure add_group [class] (A : Type) extends add_monoid A, has_neg A :=
+(add_left_inv : ∀a : A, -a + a = 0)
+
+definition add_group.to_group {A : Type} [add_group A] : group A :=
+⦃ group, add_monoid.to_monoid,
+  mul_left_inv := add_group.add_left_inv ⦄
+
+
+section add_group
+  variables [s : add_group A]
+  include s
+
+  attribute [simp]
+  theorem add.left_inv (a : A) : -a + a = 0 := add_group.add_left_inv a
+
+  attribute [simp]
+  theorem neg_add_cancel_left (a b : A) : -a + (a + b) = b :=
+  calc -a + (a + b) = (-a + a) + b : sorry -- by rewrite add.assoc
+               ...  = b            : sorry -- by simp
+
+  attribute [simp]
+  theorem neg_add_cancel_right (a b : A) : a + -b + b = a :=
+  sorry -- by simp
+
+  theorem neg_eq_of_add_eq_zero {a b : A} (H : a + b = 0) : -a = b :=
+  sorry
+  /-
+  have -a + 0 = b, by inst_simp,
+  by inst_simp
+  -/
+
+  attribute [simp]
+  theorem neg_zero : -0 = (0 : A) := neg_eq_of_add_eq_zero (zero_add 0)
+
+  attribute [simp]
+  theorem neg_neg (a : A) : -(-a) = a := neg_eq_of_add_eq_zero (add.left_inv a)
+
+  variable (A)
+  theorem left_inverse_neg : function.left_inverse (λ a : A, - a) (λ a, - a) :=
+  take a, neg_neg a
+  variable {A}
+
+  theorem eq_neg_of_add_eq_zero {a b : A} (H : a + b = 0) : a = -b :=
+  have -a = b, from neg_eq_of_add_eq_zero H,
+  sorry -- by inst_simp
+
+  theorem neg.inj {a b : A} (H : -a = -b) : a = b :=
+  sorry
+  /-
+  have a = -(-a), by simp_nohyps,
+  by inst_simp
+  -/
+
+  theorem neg_eq_neg_iff_eq (a b : A) : -a = -b ↔ a = b :=
+  sorry -- iff.intro (assume H, neg.inj H) (by simp)
+
+  theorem eq_of_neg_eq_neg {a b : A} : -a = -b → a = b :=
+  iff.mp (neg_eq_neg_iff_eq a b)
+
+  theorem neg_eq_zero_iff_eq_zero (a : A) : -a = 0 ↔ a = 0 :=
+  have -a = -0 ↔ a = 0, from neg_eq_neg_iff_eq a 0,
+  sorry -- by simp
+
+  theorem eq_zero_of_neg_eq_zero {a : A} : -a = 0 → a = 0 :=
+  iff.mp (neg_eq_zero_iff_eq_zero a)
+
+  theorem eq_neg_of_eq_neg {a b : A} (H : a = -b) : b = -a :=
+  sorry -- by simp
+
+  theorem eq_neg_iff_eq_neg (a b : A) : a = -b ↔ b = -a :=
+  iff.intro eq_neg_of_eq_neg eq_neg_of_eq_neg
+
+  attribute [simp]
+  theorem add.right_inv (a : A) : a + -a = 0 :=
+  sorry
+  /-
+  have a = -(-a), by simp,
+  by inst_simp
+  -/
+
+  attribute [simp]
+  theorem add_neg_cancel_left (a b : A) : a + (-a + b) = b :=
+  sorry -- by inst_simp
+
+  attribute [simp]
+  theorem add_neg_cancel_right (a b : A) : a + b + -b = a :=
+  sorry -- by simp
+
+  attribute [simp]
+  theorem neg_add_rev (a b : A) : -(a + b) = -b + -a :=
+  sorry -- neg_eq_of_add_eq_zero (by simp)
+
+  -- TODO: delete these in favor of sub rules?
+  theorem eq_add_neg_of_add_eq {a b c : A} (H : a + c = b) : a = b + -c :=
+  sorry -- by simp
+
+  theorem eq_neg_add_of_add_eq {a b c : A} (H : b + a = c) : a = -b + c :=
+  sorry -- by simp
+
+  theorem neg_add_eq_of_eq_add {a b c : A} (H : b = a + c) : -a + b = c :=
+  sorry -- by simp
+
+  theorem add_neg_eq_of_eq_add {a b c : A} (H : a = c + b) : a + -b = c :=
+  sorry -- by simp
+
+  theorem eq_add_of_add_neg_eq {a b c : A} (H : a + -c = b) : a = b + c :=
+  sorry -- by simp
+
+  theorem eq_add_of_neg_add_eq {a b c : A} (H : -b + a = c) : a = b + c :=
+  sorry -- by simp
+
+  theorem add_eq_of_eq_neg_add {a b c : A} (H : b = -a + c) : a + b = c :=
+  sorry -- by simp
+
+  theorem add_eq_of_eq_add_neg {a b c : A} (H : a = c + -b) : a + b = c :=
+  sorry -- by simp
+
+  theorem add_eq_iff_eq_neg_add (a b c : A) : a + b = c ↔ b = -a + c :=
+  iff.intro eq_neg_add_of_add_eq add_eq_of_eq_neg_add
+
+  theorem add_eq_iff_eq_add_neg (a b c : A) : a + b = c ↔ a = c + -b :=
+  iff.intro eq_add_neg_of_add_eq add_eq_of_eq_add_neg
+
+  theorem add_left_cancel {a b c : A} (H : a + b = a + c) : b = c :=
+  sorry
+  /-
+  have -a + (a + b) = b, by inst_simp,
+  by inst_simp
+  -/
+
+  theorem add_right_cancel {a b c : A} (H : a + b = c + b) : a = c :=
+  sorry
+  /-
+  have a + b + -b = a, by inst_simp,
+  by inst_simp
+  -/
+
+  attribute [instance]
+  definition add_group.to_left_cancel_semigroup : add_left_cancel_semigroup A :=
+  ⦃ add_left_cancel_semigroup, s,
+    add_left_cancel := @add_left_cancel A s ⦄
+
+  attribute [instance]
+  definition add_group.to_add_right_cancel_semigroup :
+    add_right_cancel_semigroup A :=
+  ⦃ add_right_cancel_semigroup, s,
+    add_right_cancel := @add_right_cancel A s ⦄
+
+  theorem add_neg_eq_neg_add_rev {a b : A} : a + -b = -(b + -a) :=
+  sorry -- by simp
+
+  theorem ne_add_of_ne_zero_right (a : A) {b : A} (H : b ≠ 0) : a ≠ b + a :=
+  sorry
+  /-
+    begin
+      intro Heq,
+      apply H,
+      rewrite [-zero_add a at Heq{1}],
+      let Heq' := eq_of_add_eq_add_right Heq,
+      apply eq.symm Heq'
+    end
+  -/
+
+  theorem ne_add_of_ne_zero_left (a : A) {b : A} (H : b ≠ 0) : a ≠ a + b :=
+  sorry
+  /-
+    begin
+      intro Heq,
+      apply H,
+      rewrite [-add_zero a at Heq{1}],
+      let Heq' := eq_of_add_eq_add_left Heq,
+      apply eq.symm Heq'
+    end
+  -/
+
+  /- sub -/
+
+  -- TODO: derive corresponding facts for div in a field
+  attribute [reducible]
+  protected definition algebra.sub (a b : A) : A := a + -b
+
+  attribute [instance]
+  definition add_group_has_sub : has_sub A :=
+  has_sub.mk algebra.sub
+
+  attribute [simp]
+  theorem sub_eq_add_neg (a b : A) : a - b = a + -b := rfl
+
+  theorem sub_self (a : A) : a - a = 0 := add.right_inv a
+
+  theorem sub_add_cancel (a b : A) : a - b + b = a := neg_add_cancel_right a b
+
+  theorem add_sub_cancel (a b : A) : a + b - b = a := add_neg_cancel_right a b
+
+  theorem add_sub_assoc (a b c : A) : a + b - c = a + (b - c) :=
+  sorry -- by rewrite [sub_eq_add_neg, add.assoc, -sub_eq_add_neg]
+
+  theorem eq_of_sub_eq_zero {a b : A} (H : a - b = 0) : a = b :=
+  sorry
+  /-
+  have -a + 0 = -a, by inst_simp,
+  by inst_simp
+  -/
+
+  theorem eq_iff_sub_eq_zero (a b : A) : a = b ↔ a - b = 0 :=
+  iff.intro (assume H, eq.subst H (sub_self _)) (assume H, eq_of_sub_eq_zero H)
+
+  theorem zero_sub (a : A) : 0 - a = -a := zero_add (-a)
+
+  theorem sub_zero (a : A) : a - 0 = a :=
+  sorry -- by simp
+
+  theorem sub_ne_zero_of_ne {a b : A} (H : a ≠ b) : a - b ≠ 0 :=
+  sorry
+  /-
+    begin
+      intro Hab,
+      apply H,
+      apply eq_of_sub_eq_zero Hab
+    end
+  -/
+
+  theorem sub_neg_eq_add (a b : A) : a - (-b) = a + b :=
+  sorry -- by simp
+
+  theorem neg_sub (a b : A) : -(a - b) = b - a :=
+  sorry -- neg_eq_of_add_eq_zero (by inst_simp)
+
+  theorem add_sub (a b c : A) : a + (b - c) = a + b - c :=
+  sorry -- by simp
+
+  theorem sub_add_eq_sub_sub_swap (a b c : A) : a - (b + c) = a - c - b :=
+  sorry -- by inst_simp
+
+  theorem sub_eq_iff_eq_add (a b c : A) : a - b = c ↔ a = c + b :=
+  iff.intro (assume H, eq_add_of_add_neg_eq H) (assume H, add_neg_eq_of_eq_add H)
+
+  theorem eq_sub_iff_add_eq (a b c : A) : a = b - c ↔ a + c = b :=
+  iff.intro (assume H, add_eq_of_eq_add_neg H) (assume H, eq_add_neg_of_add_eq H)
+
+  theorem eq_iff_eq_of_sub_eq_sub {a b c d : A} (H : a - b = c - d) : a = b ↔ c = d :=
+  calc
+    a = b ↔ a - b = 0   : eq_iff_sub_eq_zero a b
+      ... = (c - d = 0) : sorry -- by rewrite H
+      ... ↔ c = d       : iff.symm (eq_iff_sub_eq_zero c d)
+
+  theorem eq_sub_of_add_eq {a b c : A} (H : a + c = b) : a = b - c :=
+  sorry -- by simp
+
+  theorem sub_eq_of_eq_add {a b c : A} (H : a = c + b) : a - b = c :=
+  sorry -- by simp
+
+  theorem eq_add_of_sub_eq {a b c : A} (H : a - c = b) : a = b + c :=
+  sorry -- by simp
+
+  theorem add_eq_of_eq_sub {a b c : A} (H : a = c - b) : a + b = c :=
+  sorry -- by simp
+
+  theorem left_inverse_sub_add_left (c : A) : function.left_inverse (λ x, x - c) (λ x, x + c) :=
+  take x, add_sub_cancel x c
+
+  theorem left_inverse_add_left_sub (c : A) : function.left_inverse (λ x, x + c) (λ x, x - c) :=
+  take x, sub_add_cancel x c
+
+  theorem left_inverse_add_right_neg_add (c : A) :
+      function.left_inverse (λ x, c + x) (λ x, - c + x) :=
+  take x, add_neg_cancel_left c x
+
+  theorem left_inverse_neg_add_add_right (c : A) :
+      function.left_inverse (λ x, - c + x) (λ x, c + x) :=
+  take x, neg_add_cancel_left c x
+end add_group
+
+structure add_comm_group [class] (A : Type) extends add_group A, add_comm_monoid A
+
+section add_comm_group
+  variable [s : add_comm_group A]
+  include s
+
+  theorem sub_add_eq_sub_sub (a b c : A) : a - (b + c) = a - b - c :=
+  sorry -- by simp
+
+  theorem neg_add_eq_sub (a b : A) : -a + b = b - a :=
+  sorry -- by simp
+
+  theorem neg_add (a b : A) : -(a + b) = -a + -b :=
+  sorry -- by simp
+
+  theorem sub_add_eq_add_sub (a b c : A) : a - b + c = a + c - b :=
+  sorry -- by simp
+
+  theorem sub_sub (a b c : A) : a - b - c = a - (b + c) :=
+  sorry -- by simp
+
+  theorem add_sub_add_left_eq_sub (a b c : A) : (c + a) - (c + b) = a - b :=
+  sorry -- by simp
+
+  theorem eq_sub_of_add_eq' {a b c : A} (H : c + a = b) : a = b - c :=
+  sorry -- by simp
+
+  theorem sub_eq_of_eq_add' {a b c : A} (H : a = b + c) : a - b = c :=
+  sorry -- by simp
+
+  theorem eq_add_of_sub_eq' {a b c : A} (H : a - b = c) : a = b + c :=
+  sorry -- by simp
+
+  theorem add_eq_of_eq_sub' {a b c : A} (H : b = c - a) : a + b = c :=
+  sorry -- by simp
+
+  theorem sub_sub_self (a b : A) : a - (a - b) = b :=
+  sorry -- by simp
+
+  theorem add_sub_comm (a b c d : A) : a + b - (c + d) = (a - c) + (b - d) :=
+  sorry -- by simp
+
+  theorem sub_eq_sub_add_sub (a b c : A) : a - b = c - b + (a - c) :=
+  sorry -- by simp
+
+  theorem neg_neg_sub_neg (a b : A) : - (-a - -b) = a - b :=
+  sorry -- by simp
+
+end add_comm_group
+
+definition group_of_add_group (A : Type) [G : add_group A] : group A :=
+⦃group,
+  mul             := has_add.add,
+  mul_assoc       := add.assoc,
+  one             := has_zero.zero A,
+  one_mul         := zero_add,
+  mul_one         := add_zero,
+  inv             := has_neg.neg,
+  mul_left_inv    := add.left_inv⦄
+
+namespace norm_num
+reveal add.assoc
+
+definition add1 [has_add A] [has_one A] (a : A) : A := add a one
+
+local attribute add1 bit0 bit1 [reducible]
+
+theorem add_comm_four [add_comm_semigroup A] (a b : A) : a + a + (b + b) = (a + b) + (a + b) :=
+sorry -- by simp
+
+theorem add_comm_middle [add_comm_semigroup A] (a b c : A) : a + b + c = a + c + b :=
+sorry -- by simp
+
+theorem bit0_add_bit0 [add_comm_semigroup A] (a b : A) : bit0 a + bit0 b = bit0 (a + b) :=
+sorry -- by simp
+
+theorem bit0_add_bit0_helper [add_comm_semigroup A] (a b t : A) (H : a + b = t) :
+        bit0 a + bit0 b = bit0 t :=
+sorry -- by rewrite -H; simp
+
+theorem bit1_add_bit0 [add_comm_semigroup A] [has_one A] (a b : A) :
+        bit1 a + bit0 b = bit1 (a + b) :=
+sorry -- by simp
+
+theorem bit1_add_bit0_helper [add_comm_semigroup A] [has_one A] (a b t : A)
+        (H : a + b = t) : bit1 a + bit0 b = bit1 t :=
+sorry -- by rewrite -H; simp
+
+theorem bit0_add_bit1 [add_comm_semigroup A] [has_one A] (a b : A) :
+        bit0 a + bit1 b = bit1 (a + b) :=
+sorry -- by simp
+
+theorem bit0_add_bit1_helper [add_comm_semigroup A] [has_one A] (a b t : A)
+        (H : a + b = t) : bit0 a + bit1 b = bit1 t :=
+sorry -- by rewrite -H; simp
+
+theorem bit1_add_bit1 [add_comm_semigroup A] [has_one A] (a b : A) :
+        bit1 a + bit1 b = bit0 (add1 (a + b)) :=
+sorry -- by simp
+
+theorem bit1_add_bit1_helper [add_comm_semigroup A] [has_one A] (a b t s: A)
+        (H : (a + b) = t) (H2 : add1 t = s) : bit1 a + bit1 b = bit0 s :=
+sorry -- by inst_simp
+
+theorem bin_add_zero [add_monoid A] (a : A) : a + zero = a :=
+sorry -- by simp
+
+theorem bin_zero_add [add_monoid A] (a : A) : zero + a = a :=
+sorry -- by simp
+
+theorem one_add_bit0 [add_comm_semigroup A] [has_one A] (a : A) : one + bit0 a = bit1 a :=
+sorry -- by simp
+
+theorem bit0_add_one [has_add A] [has_one A] (a : A) : bit0 a + one = bit1 a :=
+rfl
+
+theorem bit1_add_one [has_add A] [has_one A] (a : A) : bit1 a + one = add1 (bit1 a) :=
+rfl
+
+theorem bit1_add_one_helper [has_add A] [has_one A] (a t : A) (H : add1 (bit1 a) = t) :
+        bit1 a + one = t :=
+sorry -- by inst_simp
+
+theorem one_add_bit1 [add_comm_semigroup A] [has_one A] (a : A) : one + bit1 a = add1 (bit1 a) :=
+sorry -- by simp
+
+theorem one_add_bit1_helper [add_comm_semigroup A] [has_one A] (a t : A)
+        (H : add1 (bit1 a) = t) : one + bit1 a = t :=
+sorry -- by inst_simp
+
+theorem add1_bit0 [has_add A] [has_one A] (a : A) : add1 (bit0 a) = bit1 a :=
+rfl
+
+theorem add1_bit1 [add_comm_semigroup A] [has_one A] (a : A) :
+        add1 (bit1 a) = bit0 (add1 a) :=
+sorry -- by simp
+
+theorem add1_bit1_helper [add_comm_semigroup A] [has_one A] (a t : A) (H : add1 a = t) :
+        add1 (bit1 a) = bit0 t :=
+sorry -- by inst_simp
+
+theorem add1_one [has_add A] [has_one A] : add1 (one : A) = bit0 one :=
+rfl
+
+theorem add1_zero [add_monoid A] [has_one A] : add1 (zero : A) = one :=
+sorry -- by simp
+
+theorem one_add_one [has_add A] [has_one A] : (one : A) + one = bit0 one :=
+rfl
+
+theorem subst_into_sum [has_add A] (l r tl tr t : A) (prl : l = tl) (prr : r = tr)
+        (prt : tl + tr = t) : l + r = t :=
+sorry -- by simp
+
+theorem neg_zero_helper [add_group A] (a : A) (H : a = 0) : - a = 0 :=
+sorry -- by simp
+
+end norm_num
+
+attribute [simp]
+  zero_add add_zero one_mul mul_one
+
+attribute [simp]
+  neg_neg sub_eq_add_neg
+
+attribute [simp]
+  add.assoc add.comm add.left_comm
+  mul.left_comm mul.comm mul.assoc

old_library/algebra/group_bigops.lean

@@ -0,0 +1,553 @@
+/-
+Copyright (c) 2015 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura, Jeremy Avigad
+
+Finite products on a monoid, and finite sums on an additive monoid. There are three versions:
+
+  Prodl, Suml : products and sums over lists
+  Prod, Sum (in namespace finset) : products and sums over finsets
+  Prod, Sum (in namespace set) : products and sums over finite sets
+
+We also define internal functions Prodl_semigroup and Prod_semigroup that can be used to define
+operations over commutative semigroups where there is no unit. We put them into their own namespaces
+so that they won't be very prominent. They can be used to define Min and Max in the number systems,
+or Inter for finsets.
+
+We have to be careful with dependencies. This theory imports files from finset and list, which
+import basic files from nat.
+-/
+import .group .group_power data.list.basic data.list.perm data.finset.basic data.set.finite
+open function binary quot subtype list
+
+variables {A B : Type}
+variable [deceqA : decidable_eq A]
+
+definition mulf [sgB : semigroup B] (f : A → B) : B → A → B :=
+λ b a, b * f a
+
+/-
+-- list versions.
+-/
+
+/- Prodl_semigroup: product indexed by a list, with a default for the empty list -/
+
+namespace Prodl_semigroup
+  variable [semigroup B]
+
+  definition Prodl_semigroup (dflt : B) : ∀ (l : list A) (f : A → B), B
+  | []            f := dflt
+  | (a :: l)      f := list.foldl (mulf f) (f a) l
+
+  theorem Prodl_semigroup_nil (dflt : B) (f : A → B) : Prodl_semigroup dflt nil f = dflt := rfl
+
+  theorem Prodl_semigroup_cons (dflt : B) (f : A → B) (a : A) (l : list A) :
+    Prodl_semigroup dflt (a::l) f = list.foldl (mulf f) (f a) l := rfl
+
+  theorem Prodl_semigroup_singleton (dflt : B) (f : A → B) (a : A) :
+    Prodl_semigroup dflt [a] f = f a := rfl
+
+  theorem Prodl_semigroup_cons_cons (dflt : B) (f : A → B) (a₁ a₂ : A) (l : list A) :
+    Prodl_semigroup dflt (a₁::a₂::l) f = f a₁ * Prodl_semigroup dflt (a₂::l) f :=
+  begin
+    rewrite [↑Prodl_semigroup, foldl_cons, ↑mulf at {2}],
+    generalize (f a₂),
+    induction l with a l ih,
+      {intro x, exact rfl},
+    intro x,
+    rewrite [*foldl_cons, ↑mulf at {2,3}, mul.assoc, ih]
+  end
+
+  theorem Prodl_semigroup_binary (dflt : B) (f : A → B) (a₁ a₂ : A) :
+    Prodl_semigroup dflt [a₁, a₂] f = f a₁ * f a₂ := rfl
+
+  section deceqA
+    include deceqA
+
+    theorem Prodl_semigroup_insert_of_mem (dflt : B) (f : A → B) {a : A} {l : list A} : a ∈ l →
+      Prodl_semigroup dflt (insert a l) f = Prodl_semigroup dflt l f :=
+    assume ainl, by rewrite [insert_eq_of_mem ainl]
+
+    theorem Prodl_semigroup_insert_insert_of_not_mem (dflt : B) (f : A → B)
+        {a₁ a₂ : A} {l : list A} (h₁ : a₂ ∉ l) (h₂ : a₁ ∉ insert a₂ l) :
+      Prodl_semigroup dflt (insert a₁ (insert a₂ l)) f =
+        f a₁ * Prodl_semigroup dflt (insert a₂ l) f :=
+    by rewrite [insert_eq_of_not_mem h₂, insert_eq_of_not_mem h₁, Prodl_semigroup_cons_cons]
+  end deceqA
+end Prodl_semigroup
+
+/- Prodl: product indexed by a list -/
+
+section monoid
+  variable [monoid B]
+
+  definition Prodl (l : list A) (f : A → B) : B :=
+  list.foldl (mulf f) 1 l
+
+  -- ∏ x ← l, f x
+  notation `∏` binders `←` l `, ` r:(scoped f, Prodl l f) := r
+
+  private theorem foldl_const (f : A → B) :
+    ∀ (l : list A) (b : B), foldl (mulf f) b l = b * foldl (mulf f) 1 l
+  | []     b := by rewrite [*foldl_nil, mul_one]
+  | (a::l) b := by rewrite [*foldl_cons, foldl_const, {foldl _ (mulf f 1 a) _}foldl_const, ↑mulf,
+                             one_mul, mul.assoc]
+
+  theorem Prodl_nil (f : A → B) : Prodl [] f = 1 := rfl
+
+  theorem Prodl_cons (f : A → B) (a : A) (l : list A) : Prodl (a::l) f = f a * Prodl l f :=
+  by rewrite [↑Prodl, foldl_cons, foldl_const, ↑mulf, one_mul]
+
+  theorem Prodl_append :
+    ∀ (l₁ l₂ : list A) (f : A → B), Prodl (l₁++l₂) f = Prodl l₁ f * Prodl l₂ f
+  | []    l₂ f  := by rewrite [append_nil_left, Prodl_nil, one_mul]
+  | (a::l) l₂ f := by rewrite [append_cons, *Prodl_cons, Prodl_append, mul.assoc]
+
+  section deceqA
+    include deceqA
+
+    theorem Prodl_insert_of_mem (f : A → B) {a : A} {l : list A} : a ∈ l →
+      Prodl (insert a l) f = Prodl l f :=
+    assume ainl, by rewrite [insert_eq_of_mem ainl]
+
+    theorem Prodl_insert_of_not_mem (f : A → B) {a : A} {l : list A} :
+      a ∉ l → Prodl (insert a l) f = f a * Prodl l f :=
+    assume nainl, by rewrite [insert_eq_of_not_mem nainl, Prodl_cons]
+
+    theorem Prodl_union {l₁ l₂ : list A} (f : A → B) (d : disjoint l₁ l₂) :
+      Prodl (union l₁ l₂) f = Prodl l₁ f * Prodl l₂ f :=
+    by rewrite [union_eq_append d, Prodl_append]
+  end deceqA
+
+  theorem Prodl_one : ∀(l : list A), Prodl l (λ x, 1) = (1:B)
+  | []     := rfl
+  | (a::l) := by rewrite [Prodl_cons, Prodl_one, mul_one]
+
+  lemma Prodl_singleton (a : A) (f : A → B) : Prodl [a] f = f a :=
+  !one_mul
+
+  lemma Prodl_map {f : A → B} :
+    ∀ {l : list A}, Prodl l f = Prodl (map f l) id
+  | nil    := by rewrite [map_nil]
+  | (a::l) := begin rewrite [map_cons, Prodl_cons f, Prodl_cons id (f a), Prodl_map] end
+
+  open nat
+  lemma Prodl_eq_pow_of_const {f : A → B} :
+    ∀ {l : list A} b, (∀ a, a ∈ l → f a = b) → Prodl l f = b ^ length l
+  | nil    := take b, assume Pconst, by rewrite [length_nil, {b^0}pow_zero]
+  | (a::l) := take b, assume Pconst,
+    have Pconstl : ∀ a', a' ∈ l → f a' = b,
+      from take a' Pa'in, Pconst a' (mem_cons_of_mem a Pa'in),
+    by rewrite [Prodl_cons f, Pconst a !mem_cons, Prodl_eq_pow_of_const b Pconstl, length_cons,
+                add_one, pow_succ b]
+end monoid
+
+section comm_monoid
+  variable [comm_monoid B]
+
+  theorem Prodl_mul (l : list A) (f g : A → B) : Prodl l (λx, f x * g x) = Prodl l f * Prodl l g :=
+  list.induction_on l
+     (by rewrite [*Prodl_nil, mul_one])
+     (take a l,
+       assume IH,
+       by rewrite [*Prodl_cons, IH, *mul.assoc, mul.left_comm (Prodl l f)])
+end comm_monoid
+
+/- Suml: sum indexed by a list -/
+
+section add_monoid
+  variable [add_monoid B]
+  local attribute add_monoid.to_monoid [trans_instance]
+
+  definition Suml (l : list A) (f : A → B) : B := Prodl l f
+
+  -- ∑ x ← l, f x
+  notation `∑` binders `←` l `, ` r:(scoped f, Suml l f) := r
+
+  theorem Suml_nil (f : A → B) : Suml [] f = 0 := Prodl_nil f
+  theorem Suml_cons (f : A → B) (a : A) (l : list A) : Suml (a::l) f = f a + Suml l f :=
+    Prodl_cons f a l
+  theorem Suml_append (l₁ l₂ : list A) (f : A → B) : Suml (l₁++l₂) f = Suml l₁ f + Suml l₂ f :=
+    Prodl_append l₁ l₂ f
+
+  section deceqA
+    include deceqA
+    theorem Suml_insert_of_mem (f : A → B) {a : A} {l : list A} (H : a ∈ l) :
+      Suml (insert a l) f = Suml l f := Prodl_insert_of_mem f H
+    theorem Suml_insert_of_not_mem (f : A → B) {a : A} {l : list A} (H : a ∉ l) :
+      Suml (insert a l) f = f a + Suml l f := Prodl_insert_of_not_mem f H
+    theorem Suml_union {l₁ l₂ : list A} (f : A → B) (d : disjoint l₁ l₂) :
+      Suml (union l₁ l₂) f = Suml l₁ f + Suml l₂ f := Prodl_union f d
+  end deceqA
+
+  theorem Suml_zero (l : list A) : Suml l (λ x, 0) = (0:B) := Prodl_one l
+  theorem Suml_singleton (a : A) (f : A → B) : Suml [a] f = f a := Prodl_singleton a f
+end add_monoid
+
+section add_comm_monoid
+  variable [acmB : add_comm_monoid B]
+  include acmB
+  local attribute add_comm_monoid.to_comm_monoid [trans_instance]
+
+  theorem Suml_add (l : list A) (f g : A → B) : Suml l (λx, f x + g x) = Suml l f + Suml l g :=
+    Prodl_mul l f g
+end add_comm_monoid
+
+/-
+-- finset versions
+-/
+
+/- Prod_semigroup : product indexed by a finset, with a default for the empty finset -/
+
+namespace finset
+  variable [comm_semigroup B]
+
+  theorem mulf_rcomm (f : A → B) : right_commutative (mulf f) :=
+  right_commutative_comp_right (@has_mul.mul B _) f (@mul.right_comm B _)
+
+  namespace Prod_semigroup
+  open Prodl_semigroup
+
+  private theorem Prodl_semigroup_eq_Prodl_semigroup_of_perm
+        (dflt : B) (f : A → B) {l₁ l₂ : list A} (p : perm l₁ l₂) :
+      Prodl_semigroup dflt l₁ f = Prodl_semigroup dflt l₂ f :=
+    perm.induction_on p
+      rfl    -- nil nil
+      (take x l₁ l₂ p ih,
+        by rewrite [*Prodl_semigroup_cons, perm.foldl_eq_of_perm (mulf_rcomm f) p])
+      (take x y l,
+        begin rewrite [*Prodl_semigroup_cons, *foldl_cons, ↑mulf, mul.comm] end)
+      (take l₁ l₂ l₃ p₁ p₂ ih₁ ih₂, eq.trans ih₁ ih₂)
+
+  definition Prod_semigroup (dflt : B) (s : finset A) (f : A → B) : B :=
+  quot.lift_on s
+    (λ l, Prodl_semigroup dflt (elt_of l) f)
+    (λ l₁ l₂ p, Prodl_semigroup_eq_Prodl_semigroup_of_perm dflt f p)
+
+  theorem Prod_semigroup_empty (dflt : B) (f : A → B) : Prod_semigroup dflt ∅ f = dflt := rfl
+
+  section deceqA
+    include deceqA
+
+    theorem Prod_semigroup_singleton (dflt : B) (f : A → B) (a : A) :
+      Prod_semigroup dflt '{a} f = f a := rfl
+
+    theorem Prod_semigroup_insert_insert (dflt : B) (f : A → B) {a₁ a₂ : A} {s : finset A} :
+        a₂ ∉ s → a₁ ∉ insert a₂ s →
+      Prod_semigroup dflt (insert a₁ (insert a₂ s)) f =
+        f a₁ * Prod_semigroup dflt (insert a₂ s) f :=
+    quot.induction_on s
+      (take l h₁ h₂, Prodl_semigroup_insert_insert_of_not_mem dflt f h₁ h₂)
+
+    theorem Prod_semigroup_insert (dflt : B) (f : A → B) {a : A} {s : finset A} (anins : a ∉ s)
+        (sne : s ≠ ∅) :
+      Prod_semigroup dflt (insert a s) f = f a * Prod_semigroup dflt s f :=
+    obtain a' (a's : a' ∈ s), from exists_mem_of_ne_empty sne,
+    have H : s = insert a' (erase a' s), from eq.symm (insert_erase a's),
+    begin
+      rewrite [H, Prod_semigroup_insert_insert dflt f !not_mem_erase (eq.subst H anins)]
+    end
+  end deceqA
+  end Prod_semigroup
+end finset
+
+/- Prod: product indexed by a finset -/
+
+namespace finset
+  variable [comm_monoid B]
+
+  theorem Prodl_eq_Prodl_of_perm (f : A → B) {l₁ l₂ : list A} :
+    perm l₁ l₂ → Prodl l₁ f = Prodl l₂ f :=
+  λ p, perm.foldl_eq_of_perm (mulf_rcomm f) p 1
+
+  definition Prod (s : finset A) (f : A → B) : B :=
+  quot.lift_on s
+    (λ l, Prodl (elt_of l) f)
+    (λ l₁ l₂ p, Prodl_eq_Prodl_of_perm f p)
+
+  -- ∏ x ∈ s, f x
+  notation `∏` binders `∈` s `, ` r:(scoped f, Prod s f) := r
+
+  theorem Prod_empty (f : A → B) : Prod ∅ f = 1 :=
+  Prodl_nil f
+
+  theorem Prod_mul (s : finset A) (f g : A → B) : Prod s (λx, f x * g x) = Prod s f * Prod s g :=
+  quot.induction_on s (take u, !Prodl_mul)
+
+  theorem Prod_one (s : finset A) : Prod s (λ x, 1) = (1:B) :=
+  quot.induction_on s (take u, !Prodl_one)
+
+  section deceqA
+    include deceqA
+
+    theorem Prod_insert_of_mem (f : A → B) {a : A} {s : finset A} :
+      a ∈ s → Prod (insert a s) f = Prod s f :=
+    quot.induction_on s
+      (λ l ainl, Prodl_insert_of_mem f ainl)
+
+    theorem Prod_insert_of_not_mem (f : A → B) {a : A} {s : finset A} :
+      a ∉ s → Prod (insert a s) f = f a * Prod s f :=
+    quot.induction_on s
+      (λ l nainl, Prodl_insert_of_not_mem f nainl)
+
+    theorem Prod_union (f : A → B) {s₁ s₂ : finset A} (disj : s₁ ∩ s₂ = ∅) :
+      Prod (s₁ ∪ s₂) f = Prod s₁ f * Prod s₂ f :=
+    have H1 : disjoint s₁ s₂ → Prod (s₁ ∪ s₂) f = Prod s₁ f * Prod s₂ f, from
+      quot.induction_on₂ s₁ s₂
+        (λ l₁ l₂ d, Prodl_union f d),
+    H1 (disjoint_of_inter_eq_empty disj)
+
+    theorem Prod_ext {s : finset A} {f g : A → B} :
+      (∀{x}, x ∈ s → f x = g x) → Prod s f = Prod s g :=
+    finset.induction_on s
+      (assume H, rfl)
+      (take x s', assume H1 : x ∉ s',
+        assume IH : (∀ {x : A}, x ∈ s' → f x = g x) → Prod s' f = Prod s' g,
+        assume H2 : ∀{y}, y ∈ insert x s' → f y = g y,
+        have H3 : ∀y, y ∈ s' → f y = g y, from
+          take y, assume H', H2 (mem_insert_of_mem _ H'),
+        have H4 : f x = g x, from H2 !mem_insert,
+        by rewrite [Prod_insert_of_not_mem f H1, Prod_insert_of_not_mem g H1, IH H3, H4])
+
+    theorem Prod_singleton (a : A) (f : A → B) : Prod '{a} f = f a :=
+    have a ∉ ∅, from not_mem_empty a,
+    by rewrite [Prod_insert_of_not_mem f this, Prod_empty, mul_one]
+
+    theorem Prod_image {C : Type} [deceqC : decidable_eq C] {s : finset A} (f : C → B) {g : A → C}
+                       (H : set.inj_on g (to_set s)) :
+            (∏ j ∈ image g s, f j) = (∏ i ∈ s, f (g i)) :=
+    begin
+      induction s with a s anins ih,
+        {rewrite [*Prod_empty]},
+      have injg : set.inj_on g (to_set s),
+        from set.inj_on_of_inj_on_of_subset H (λ x, mem_insert_of_mem a),
+      have g a ∉ g ' s, from
+        suppose g a ∈ g ' s,
+        obtain b [(bs : b ∈ s) (gbeq : g b = g a)], from exists_of_mem_image this,
+        have aias : set.mem a (to_set (insert a s)),
+          by rewrite to_set_insert; apply set.mem_insert a s,
+        have bias : set.mem b (to_set (insert a s)),
+          by rewrite to_set_insert; apply set.mem_insert_of_mem; exact bs,
+        have b = a, from H bias aias gbeq,
+        show false, from anins (eq.subst this bs),
+      rewrite [image_insert, Prod_insert_of_not_mem _ this, Prod_insert_of_not_mem _ anins, ih injg]
+    end
+
+    theorem Prod_eq_of_bij_on {C : Type} [deceqC : decidable_eq C] {s : finset A} {t : finset C}
+                              (f : C → B) {g : A → C} (H : set.bij_on g (to_set s) (to_set t)) :
+            (∏ j ∈ t, f j) = (∏ i ∈ s, f (g i)) :=
+    have g ' s = t,
+      by apply eq_of_to_set_eq_to_set; rewrite to_set_image; exact set.image_eq_of_bij_on H,
+    using this, by rewrite [-this, Prod_image f (and.left (and.right H))]
+  end deceqA
+end finset
+
+/- Sum: sum indexed by a finset -/
+
+namespace finset
+  variable [add_comm_monoid B]
+  local attribute add_comm_monoid.to_comm_monoid [trans_instance]
+
+  definition Sum (s : finset A) (f : A → B) : B := Prod s f
+
+  -- ∑ x ∈ s, f x
+  notation `∑` binders `∈` s `, ` r:(scoped f, Sum s f) := r
+
+  theorem Sum_empty (f : A → B) : Sum ∅ f = 0 := Prod_empty f
+  theorem Sum_add (s : finset A) (f g : A → B) :
+    Sum s (λx, f x + g x) = Sum s f + Sum s g := Prod_mul s f g
+  theorem Sum_zero (s : finset A) : Sum s (λ x, 0) = (0:B) := Prod_one s
+
+  section deceqA
+    include deceqA
+    theorem Sum_insert_of_mem (f : A → B) {a : A} {s : finset A} (H : a ∈ s) :
+      Sum (insert a s) f = Sum s f := Prod_insert_of_mem f H
+    theorem Sum_insert_of_not_mem (f : A → B) {a : A} {s : finset A} (H : a ∉ s) :
+      Sum (insert a s) f = f a + Sum s f := Prod_insert_of_not_mem f H
+    theorem Sum_union (f : A → B) {s₁ s₂ : finset A} (disj : s₁ ∩ s₂ = ∅) :
+      Sum (s₁ ∪ s₂) f = Sum s₁ f + Sum s₂ f := Prod_union f disj
+    theorem Sum_ext {s : finset A} {f g : A → B} (H : ∀x, x ∈ s → f x = g x) :
+      Sum s f = Sum s g := Prod_ext H
+    theorem Sum_singleton (a : A) (f : A → B) : Sum '{a} f = f a := Prod_singleton a f
+
+    theorem Sum_image {C : Type} [deceqC : decidable_eq C] {s : finset A} (f : C → B) {g : A → C}
+                      (H : set.inj_on g (to_set s)) :
+            (∑ j ∈ image g s, f j) = (∑ i ∈ s, f (g i)) := Prod_image f H
+    theorem Sum_eq_of_bij_on {C : Type} [deceqC : decidable_eq C] {s : finset A} {t : finset C}
+                             (f : C → B) {g : A → C} (H : set.bij_on g (to_set s) (to_set t)) :
+            (∑ j ∈ t, f j) = (∑ i ∈ s, f (g i)) := Prod_eq_of_bij_on f H
+  end deceqA
+end finset
+
+/-
+-- set versions
+-/
+
+namespace set
+local attribute classical.prop_decidable [instance]
+
+/- Prod: product indexed by a set -/
+
+section Prod
+  variable [comm_monoid B]
+
+  noncomputable definition Prod (s : set A) (f : A → B) : B := finset.Prod (to_finset s) f
+
+  -- ∏ x ∈ s, f x
+  notation `∏` binders `∈` s `, ` r:(scoped f, Prod s f) := r
+
+  theorem Prod_empty (f : A → B) : Prod ∅ f = 1 :=
+  by rewrite [↑Prod, to_finset_empty]
+
+  theorem Prod_of_not_finite {s : set A} (nfins : ¬ finite s) (f : A → B) : Prod s f = 1 :=
+  by rewrite [↑Prod, to_finset_of_not_finite nfins]
+
+  theorem Prod_mul (s : set A) (f g : A → B) : Prod s (λx, f x * g x) = Prod s f * Prod s g :=
+  by rewrite [↑Prod, finset.Prod_mul]
+
+  theorem Prod_one (s : set A) : Prod s (λ x, 1) = (1:B) :=
+  by rewrite [↑Prod, finset.Prod_one]
+
+  theorem Prod_insert_of_mem (f : A → B) {a : A} {s : set A} (H : a ∈ s) :
+    Prod (insert a s) f = Prod s f :=
+  by_cases
+    (suppose finite s,
+      have (#finset a ∈ set.to_finset s), by rewrite mem_to_finset_eq; apply H,
+      by rewrite [↑Prod, to_finset_insert, finset.Prod_insert_of_mem f this])
+    (assume nfs : ¬ finite s,
+      have ¬ finite (insert a s), from assume H, nfs (finite_of_finite_insert H),
+      by rewrite [Prod_of_not_finite nfs, Prod_of_not_finite this])
+
+  theorem Prod_insert_of_not_mem (f : A → B) {a : A} {s : set A} [finite s] (H : a ∉ s) :
+    Prod (insert a s) f = f a * Prod s f :=
+  have (#finset a ∉ set.to_finset s), by rewrite mem_to_finset_eq; apply H,
+  by rewrite [↑Prod, to_finset_insert, finset.Prod_insert_of_not_mem f this]
+
+  theorem Prod_union (f : A → B) {s₁ s₂ : set A} [finite s₁] [finite s₂]
+      (disj : s₁ ∩ s₂ = ∅) :
+    Prod (s₁ ∪ s₂) f = Prod s₁ f * Prod s₂ f :=
+  begin
+    rewrite [↑Prod, to_finset_union],
+    apply finset.Prod_union,
+    apply finset.eq_of_to_set_eq_to_set,
+    rewrite [finset.to_set_inter, *to_set_to_finset, finset.to_set_empty, disj]
+  end
+
+  theorem Prod_ext {s : set A} {f g : A → B} (H : ∀{x}, x ∈ s → f x = g x) : Prod s f = Prod s g :=
+  by_cases
+    (suppose finite s,
+      by esimp [Prod]; apply finset.Prod_ext; intro x; rewrite [mem_to_finset_eq]; apply H)
+    (assume nfs : ¬ finite s,
+      by rewrite [*Prod_of_not_finite nfs])
+
+  theorem Prod_singleton (a : A) (f : A → B) : Prod '{a} f = f a :=
+  by rewrite [↑Prod, to_finset_insert, to_finset_empty, finset.Prod_singleton]
+
+  theorem Prod_image {C : Type} {s : set A} [fins : finite s] (f : C → B) {g : A → C}
+                     (H : inj_on g s) :
+          (∏ j ∈ image g s, f j) = (∏ i ∈ s, f (g i)) :=
+  begin
+    have H' : inj_on g (finset.to_set (set.to_finset s)), by rewrite to_set_to_finset; exact H,
+    rewrite [↑Prod, to_finset_image g s, finset.Prod_image f H']
+  end
+
+  theorem Prod_eq_of_bij_on {C : Type} {s : set A} {t : set C} (f : C → B)
+                            {g : A → C} (H : bij_on g s t) :
+          (∏ j ∈ t, f j) = (∏ i ∈ s, f (g i)) :=
+  by_cases
+    (suppose finite s,
+      have g ' s = t, from image_eq_of_bij_on H,
+      using this, by rewrite [-this, Prod_image f (and.left (and.right H))])
+    (assume nfins : ¬ finite s,
+      have nfint : ¬ finite t, from
+        suppose finite t,
+        have finite s, from finite_of_bij_on' H,
+        show false, from nfins this,
+      by rewrite [Prod_of_not_finite nfins, Prod_of_not_finite nfint])
+end Prod
+
+/- Sum: sum indexed by a set -/
+
+section Sum
+  variable [add_comm_monoid B]
+  local attribute add_comm_monoid.to_comm_monoid [trans_instance]
+
+  noncomputable definition Sum (s : set A) (f : A → B) : B := Prod s f
+
+  proposition Sum_def (s : set A) (f : A → B) : Sum s f = finset.Sum (to_finset s) f := rfl
+
+  -- ∑ x ∈ s, f x
+  notation `∑` binders `∈` s `, ` r:(scoped f, Sum s f) := r
+
+  theorem Sum_empty (f : A → B) : Sum ∅ f = 0 := Prod_empty f
+  theorem Sum_of_not_finite {s : set A} (nfins : ¬ finite s) (f : A → B) : Sum s f = 0 :=
+    Prod_of_not_finite nfins f
+  theorem Sum_add (s : set A) (f g : A → B) :
+    Sum s (λx, f x + g x) = Sum s f + Sum s g := Prod_mul s f g
+  theorem Sum_zero (s : set A) : Sum s (λ x, 0) = (0:B) := Prod_one s
+
+  theorem Sum_insert_of_mem (f : A → B) {a : A} {s : set A} (H : a ∈ s) :
+    Sum (insert a s) f = Sum s f := Prod_insert_of_mem f H
+  theorem Sum_insert_of_not_mem (f : A → B) {a : A} {s : set A} [finite s] (H : a ∉ s) :
+    Sum (insert a s) f = f a + Sum s f := Prod_insert_of_not_mem f H
+  theorem Sum_union (f : A → B) {s₁ s₂ : set A} [finite s₁] [finite s₂]
+      (disj : s₁ ∩ s₂ = ∅) :
+    Sum (s₁ ∪ s₂) f = Sum s₁ f + Sum s₂ f := Prod_union f disj
+  theorem Sum_ext {s : set A} {f g : A → B} (H : ∀x, x ∈ s → f x = g x) :
+    Sum s f = Sum s g := Prod_ext H
+
+  theorem Sum_singleton (a : A) (f : A → B) : Sum '{a} f = f a :=
+    Prod_singleton a f
+
+  theorem Sum_image {C : Type} {s : set A} [fins : finite s] (f : C → B) {g : A → C}
+                    (H : inj_on g s) :
+          (∑ j ∈ image g s, f j) = (∑ i ∈ s, f (g i)) := Prod_image f H
+  theorem Sum_eq_of_bij_on {C : Type} {s : set A} {t : set C} (f : C → B) {g : A → C}
+                           (H : bij_on g s t) :
+          (∑ j ∈ t, f j) = (∑ i ∈ s, f (g i)) := Prod_eq_of_bij_on f H
+end Sum
+
+/- Prod_semigroup : product indexed by a set, with a default for the empty set -/
+
+namespace Prod_semigroup
+  variable [comm_semigroup B]
+
+  noncomputable definition Prod_semigroup (dflt : B) (s : set A) (f : A → B) : B :=
+  finset.Prod_semigroup.Prod_semigroup dflt (to_finset s) f
+
+  theorem Prod_semigroup_empty (dflt : B) (f : A → B) : Prod_semigroup dflt ∅ f = dflt :=
+  by rewrite [↑Prod_semigroup, to_finset_empty]
+
+  theorem Prod_semigroup_of_not_finite (dflt : B) {s : set A} (nfins : ¬ finite s) (f : A → B) :
+    Prod_semigroup dflt s f = dflt :=
+  by rewrite [↑Prod_semigroup, to_finset_of_not_finite nfins]
+
+  theorem Prod_semigroup_singleton (dflt : B) (f : A → B) (a : A) :
+    Prod_semigroup dflt ('{a}) f = f a :=
+  by rewrite [↑Prod_semigroup, to_finset_insert, to_finset_empty,
+               finset.Prod_semigroup.Prod_semigroup_singleton dflt f a]
+
+  theorem Prod_semigroup_insert_insert (dflt : B) (f : A → B) {a₁ a₂ : A} {s : set A}
+        [h : finite s]  :
+      a₂ ∉ s → a₁ ∉ insert a₂ s →
+    Prod_semigroup dflt (insert a₁ (insert a₂ s)) f =
+      f a₁ * Prod_semigroup dflt (insert a₂ s) f :=
+  begin
+    rewrite [↑Prod_semigroup, -+mem_to_finset_eq, +to_finset_insert],
+    intro h1 h2,
+    apply finset.Prod_semigroup.Prod_semigroup_insert_insert dflt f h1 h2
+  end
+
+  theorem Prod_semigroup_insert (dflt : B) (f : A → B) {a : A} {s : set A} [h : finite s] :
+    a ∉ s → s ≠ ∅ → Prod_semigroup dflt (insert a s) f = f a * Prod_semigroup dflt s f :=
+  begin
+    rewrite [↑Prod_semigroup, -mem_to_finset_eq, +to_finset_insert, -finset.to_set_empty],
+    intro h1 h2,
+    apply finset.Prod_semigroup.Prod_semigroup_insert dflt f h1,
+    intro h3, revert h2, rewrite [-h3, to_set_to_finset],
+    intro h4, exact (h4 rfl)
+  end
+
+end Prod_semigroup
+
+end set

old_library/algebra/group_power.lean

@@ -0,0 +1,264 @@
+/-
+Copyright (c) 2015 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+
+The power operation on monoids and groups. We separate this from group, because it depends on
+nat, which in turn depends on other parts of algebra.
+
+We have "pow a n" for natural number powers, and "gpow a i" for integer powers. The notation
+a^n is used for the first, but users can locally redefine it to gpow when needed.
+
+Note: power adopts the convention that 0^0=1.
+-/
+import data.nat.basic data.int.basic
+
+variables {A : Type}
+
+structure has_pow_nat [class] (A : Type) :=
+(pow_nat : A → nat → A)
+
+definition pow_nat {A : Type} [s : has_pow_nat A] : A → nat → A :=
+has_pow_nat.pow_nat
+
+infix ` ^ ` := pow_nat
+
+structure has_pow_int [class] (A : Type) :=
+(pow_int : A → int → A)
+
+definition pow_int {A : Type} [s : has_pow_int A] : A → int → A :=
+has_pow_int.pow_int
+
+ /- monoid -/
+section monoid
+open nat
+
+variable [s : monoid A]
+include s
+
+definition monoid.pow (a : A) : ℕ → A
+| 0     := 1
+| (n+1) := a * monoid.pow n
+
+attribute [instance]
+definition monoid_has_pow_nat : has_pow_nat A :=
+has_pow_nat.mk monoid.pow
+
+theorem pow_zero (a : A) : a^0 = 1 := rfl
+theorem pow_succ (a : A) (n : ℕ) : a^(succ n) = a * a^n := rfl
+
+theorem pow_one (a : A) : a^1 = a := !mul_one
+theorem pow_two (a : A) : a^2 = a * a :=
+calc
+  a^2 = a * (a * 1) : rfl
+  ... = a * a       : mul_one
+theorem pow_three (a : A) : a^3 = a * (a * a) :=
+calc
+  a^3 = a * (a * (a * 1)) : rfl
+  ... = a * (a * a)       : mul_one
+theorem pow_four (a : A) : a^4 = a * (a * (a * a))  :=
+calc
+  a^4 = a * a^3           : rfl
+  ... = a * (a * (a * a)) : pow_three
+
+theorem pow_succ' (a : A) : ∀n, a^(succ n) = a^n * a
+| 0        := by rewrite [pow_succ, *pow_zero, one_mul, mul_one]
+| (succ n) := by rewrite [pow_succ, pow_succ' at {1}, pow_succ, mul.assoc]
+
+theorem one_pow : ∀ n : ℕ, 1^n = (1:A)
+| 0        := rfl
+| (succ n) := by rewrite [pow_succ, one_mul, one_pow]
+
+theorem pow_add (a : A) (m n : ℕ) : a^(m + n) = a^m * a^n :=
+begin
+  induction n with n ih,
+    {krewrite [nat.add_zero, pow_zero, mul_one]},
+  rewrite [add_succ, *pow_succ', ih, mul.assoc]
+end
+
+theorem pow_mul (a : A) (m : ℕ) : ∀ n, a^(m * n) = (a^m)^n
+| 0        := by rewrite [nat.mul_zero, pow_zero]
+| (succ n) := by rewrite [nat.mul_succ, pow_add, pow_succ', pow_mul]
+
+theorem pow_comm (a : A) (m n : ℕ)  : a^m * a^n = a^n * a^m :=
+by rewrite [-*pow_add, add.comm]
+
+end monoid
+
+/- commutative monoid -/
+
+section comm_monoid
+open nat
+variable [s : comm_monoid A]
+include s
+
+theorem mul_pow (a b : A) : ∀ n, (a * b)^n = a^n * b^n
+| 0        := by rewrite [*pow_zero, mul_one]
+| (succ n) := by rewrite [*pow_succ', mul_pow, *mul.assoc, mul.left_comm a]
+
+end comm_monoid
+
+section group
+variable [s : group A]
+include s
+
+section nat
+open nat
+theorem inv_pow (a : A) : ∀n, (a⁻¹)^n = (a^n)⁻¹
+| 0        := by rewrite [*pow_zero, one_inv]
+| (succ n) := by rewrite [pow_succ, pow_succ', inv_pow, mul_inv]
+
+theorem pow_sub (a : A) {m n : ℕ} (H : m ≥ n) : a^(m - n) = a^m * (a^n)⁻¹ :=
+have H1 : m - n + n = m, from nat.sub_add_cancel H,
+have H2 : a^(m - n) * a^n = a^m, by rewrite [-pow_add, H1],
+eq_mul_inv_of_mul_eq H2
+
+theorem pow_inv_comm (a : A) : ∀m n, (a⁻¹)^m * a^n = a^n * (a⁻¹)^m
+| 0 n               := by rewrite [*pow_zero, one_mul, mul_one]
+| m 0               := by rewrite [*pow_zero, one_mul, mul_one]
+| (succ m) (succ n) := by rewrite [pow_succ' at {1}, pow_succ at {1}, pow_succ', pow_succ,
+                            *mul.assoc, inv_mul_cancel_left, mul_inv_cancel_left, pow_inv_comm]
+
+end nat
+
+open int
+
+definition gpow (a : A) : ℤ → A
+| (of_nat n) := a^n
+| -[1+n]     := (a^(nat.succ n))⁻¹
+
+open nat
+
+private lemma gpow_add_aux (a : A) (m n : nat) :
+  gpow a ((of_nat m) + -[1+n]) = gpow a (of_nat m) * gpow a (-[1+n]) :=
+or.elim (nat.lt_or_ge m (nat.succ n))
+  (assume H : (m < nat.succ n),
+    have H1 : (#nat nat.succ n - m > nat.zero), from nat.sub_pos_of_lt H,
+    calc
+      gpow a ((of_nat m) + -[1+n]) = gpow a (sub_nat_nat m (nat.succ n))  : rfl
+        ... = gpow a (-[1+ nat.pred (nat.sub (nat.succ n) m)])            : {sub_nat_nat_of_lt H}
+        ... = (a ^ (nat.succ (nat.pred (nat.sub (nat.succ n) m))))⁻¹    : rfl
+        ... = (a ^ (nat.succ n) * (a ^ m)⁻¹)⁻¹                        :
+                by krewrite [succ_pred_of_pos H1, pow_sub a (nat.le_of_lt H)]
+        ... = a ^ m * (a ^ (nat.succ n))⁻¹                            :
+                by rewrite [mul_inv, inv_inv]
+        ... = gpow a (of_nat m) * gpow a (-[1+n])                         : rfl)
+  (assume H : (m ≥ nat.succ n),
+    calc
+      gpow a ((of_nat m) + -[1+n]) = gpow a (sub_nat_nat m (nat.succ n))  : rfl
+        ... = gpow a (#nat m - nat.succ n)                                : {sub_nat_nat_of_ge H}
+        ... = a ^ m * (a ^ (nat.succ n))⁻¹                                : pow_sub a H
+        ... = gpow a (of_nat m) * gpow a (-[1+n])                         : rfl)
+
+theorem gpow_add (a : A) : ∀i j : int, gpow a (i + j) = gpow a i * gpow a j
+| (of_nat m) (of_nat n) := !pow_add
+| (of_nat m) -[1+n]     := !gpow_add_aux
+| -[1+m]     (of_nat n) := by rewrite [add.comm, gpow_add_aux, ↑gpow, -*inv_pow, pow_inv_comm]
+| -[1+m]     -[1+n]     :=
+  calc
+    gpow a (-[1+m] + -[1+n]) = (a^(#nat nat.succ m + nat.succ n))⁻¹ : rfl
+      ... = (a^(nat.succ m))⁻¹ * (a^(nat.succ n))⁻¹ : by rewrite [pow_add, pow_comm, mul_inv]
+      ... = gpow a (-[1+m]) * gpow a (-[1+n])       : rfl
+
+theorem gpow_comm (a : A) (i j : ℤ) : gpow a i * gpow a j = gpow a j * gpow a i :=
+by rewrite [-*gpow_add, add.comm]
+end group
+
+section ordered_ring
+open nat
+variable [s : linear_ordered_ring A]
+include s
+
+theorem pow_pos {a : A} (H : a > 0) (n : ℕ) : a ^ n > 0 :=
+  begin
+    induction n,
+    krewrite pow_zero,
+    apply zero_lt_one,
+    rewrite pow_succ',
+    apply mul_pos,
+    apply v_0, apply H
+  end
+
+theorem pow_ge_one_of_ge_one {a : A} (H : a ≥ 1) (n : ℕ) : a ^ n ≥ 1 :=
+  begin
+    induction n,
+    krewrite pow_zero,
+    apply le.refl,
+    rewrite [pow_succ', -mul_one 1],
+    apply mul_le_mul v_0 H zero_le_one,
+    apply le_of_lt,
+    apply pow_pos,
+    apply gt_of_ge_of_gt H zero_lt_one
+  end
+
+theorem pow_two_add (n : ℕ) : (2:A)^n + 2^n = 2^(succ n) :=
+  by rewrite [pow_succ', -one_add_one_eq_two, left_distrib, *mul_one]
+
+end ordered_ring
+
+/- additive monoid -/
+
+section add_monoid
+variable [s : add_monoid A]
+include s
+local attribute add_monoid.to_monoid [trans_instance]
+open nat
+
+definition nmul : ℕ → A → A := λ n a, a^n
+
+infix [priority algebra.prio] `⬝` := nmul
+
+theorem zero_nmul (a : A) : (0:ℕ) ⬝ a = 0 := pow_zero a
+theorem succ_nmul (n : ℕ) (a : A) : nmul (succ n) a = a + (nmul n a) := pow_succ a n
+
+theorem succ_nmul' (n : ℕ) (a : A) : succ n ⬝ a = nmul n a + a := pow_succ' a n
+
+theorem nmul_zero (n : ℕ) : n ⬝ 0 = (0:A) := one_pow n
+
+theorem one_nmul (a : A) : 1 ⬝ a = a := pow_one a
+
+theorem add_nmul (m n : ℕ) (a : A) : (m + n) ⬝ a = (m ⬝ a) + (n ⬝ a) := pow_add a m n
+
+theorem mul_nmul (m n : ℕ) (a : A) : (m * n) ⬝ a = m ⬝ (n ⬝ a) := eq.subst (mul.comm n m) (pow_mul a n m)
+
+theorem nmul_comm (m n : ℕ) (a : A) : (m ⬝ a) + (n ⬝ a) = (n ⬝ a) + (m ⬝ a) := pow_comm a m n
+
+end add_monoid
+
+/- additive commutative monoid -/
+
+section add_comm_monoid
+open nat
+variable [s : add_comm_monoid A]
+include s
+local attribute add_comm_monoid.to_comm_monoid [trans_instance]
+
+theorem nmul_add (n : ℕ) (a b : A) : n ⬝ (a + b) = (n ⬝ a) + (n ⬝ b) := mul_pow a b n
+
+end add_comm_monoid
+
+section add_group
+variable [s : add_group A]
+include s
+local attribute add_group.to_group [trans_instance]
+
+section nat
+open nat
+theorem nmul_neg (n : ℕ) (a : A) : n ⬝ (-a) = -(n ⬝ a) := inv_pow a n
+
+theorem sub_nmul {m n : ℕ} (a : A) (H : m ≥ n) : (m - n) ⬝ a = (m ⬝ a) + -(n ⬝ a) := pow_sub a H
+
+theorem nmul_neg_comm (m n : ℕ) (a : A) : (m ⬝ (-a)) + (n ⬝ a) = (n ⬝ a) + (m ⬝ (-a)) := pow_inv_comm a m n
+
+end nat
+
+open int
+
+definition imul : ℤ → A → A := λ i a, gpow a i
+
+theorem add_imul (i j : ℤ) (a : A) : imul (i + j) a = imul i a + imul j a :=
+  gpow_add a i j
+
+theorem imul_comm (i j : ℤ) (a : A) : imul i a + imul j a = imul j a + imul i a := gpow_comm a i j
+
+end add_group

old_library/algebra/homomorphism.lean

@@ -0,0 +1,185 @@
+/-
+Copyright (c) 2016 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad
+
+Homomorphisms between structures:
+
+  is_add_hom    : structures with has_add
+  is_mul_hom    : structures with has_mul
+  is_module_hom : structures with has_add, has_smul
+  is_ring_hom   : structures with has_add, has_mul
+
+If you are working with a one particular kind of homomorphism, e.g. multiplicative, we recommend
+
+  local abbreviation is_hom := @is_mul_hom
+
+These are all tentatively declared as type classes. The theorems which infer id and compose
+as instances are *not*, however, declared as instances: the first is rarely useful and the
+second makes class inference loop.
+
+Type class inference is useful here because usually a hypothesis like  is_hom f  is in the context.
+If you need an instance that the system does not infer, simply put it in the context, e.g.
+
+  assert is_hom f, from ...,
+  ...
+-/
+import algebra.module data.set
+open function set
+
+variables {A B C : Type}
+
+/- additive structures -/
+
+definition add_ker [has_zero B] (f : A → B) : set A := {a | f a = 0}
+
+proposition add_ker_eq [has_zero B] (f : A → B) : add_ker f = f '- '{0} :=
+ext (take x, iff.intro
+  (assume H, mem_preimage (mem_singleton_of_eq H))
+  (assume H, eq_of_mem_singleton (mem_of_mem_preimage H)))
+
+structure is_add_hom [class] [has_add A] [has_add B] (f : A → B) : Prop :=
+(hom_add : ∀ a₁ a₂, f (a₁ + a₂) = f a₁ + f a₂)
+
+proposition hom_add [has_add A] [has_add B] (f : A → B) [H : is_add_hom f] (a₁ a₂ : A) :
+  f (a₁ + a₂) = f a₁ + f a₂ := is_add_hom.hom_add _ _ f a₁ a₂
+
+proposition is_add_hom_id [has_add A] : is_add_hom (@id A) :=
+is_add_hom.mk (take a₁ a₂, rfl)
+
+proposition is_add_hom_comp [has_add A] [has_add B] [has_add C]
+  {f : B → C} {g : A → B} [is_add_hom f] [is_add_hom g] : is_add_hom (f ∘ g) :=
+is_add_hom.mk (take a₁ a₂, by esimp; rewrite *hom_add)
+
+section add_group_A_B
+  variables [add_group A] [add_group B]
+
+  proposition hom_zero (f : A → B) [is_add_hom f] :
+    f (0 : A) = 0 :=
+  have f 0 + f 0 = f 0 + 0, by rewrite [-hom_add f, +add_zero],
+  eq_of_add_eq_add_left this
+
+  proposition hom_neg (f : A → B) [is_add_hom f] (a : A) :
+    f (- a) = - f a :=
+  have f (- a) + f a = 0, by rewrite [-hom_add f, add.left_inv, hom_zero],
+  eq_neg_of_add_eq_zero this
+
+  proposition hom_sub (f : A → B) [is_add_hom f] (a₁ a₂ : A) :
+    f (a₁ - a₂) = f a₁ - f a₂ :=
+  by rewrite [*sub_eq_add_neg, *hom_add, hom_neg]
+
+  proposition injective_hom_add [add_group B] {f : A → B} [is_add_hom f]
+      (H : ∀ x, f x = 0 → x = 0) :
+    injective f :=
+  take x₁ x₂,
+  suppose f x₁ = f x₂,
+  have f (x₁ - x₂) = 0, by rewrite [hom_sub, this, sub_self],
+  have x₁ - x₂ = 0, from H _ this,
+  eq_of_sub_eq_zero this
+
+  proposition eq_zero_of_injective_hom [add_group B] {f : A → B} [is_add_hom f]
+      (injf : injective f) {a : A} (fa0 : f a = 0) :
+    a = 0 :=
+  have f a = f 0, by rewrite [fa0, hom_zero],
+  show a = 0, from injf this
+end add_group_A_B
+
+/- multiplicative structures -/
+
+definition mul_ker [has_one B] (f : A → B) : set A := {a | f a = 1}
+
+proposition mul_ker_eq [has_one B] (f : A → B) : mul_ker f = f '- '{1} :=
+ext (take x, iff.intro
+  (assume H, mem_preimage (mem_singleton_of_eq H))
+  (assume H, eq_of_mem_singleton (mem_of_mem_preimage H)))
+
+structure is_mul_hom [class] [has_mul A] [has_mul B] (f : A → B) : Prop :=
+(hom_mul : ∀ a₁ a₂, f (a₁ * a₂) = f a₁ * f a₂)
+
+proposition hom_mul [has_mul A] [has_mul B] (f : A → B) [H : is_mul_hom f] (a₁ a₂ : A) :
+  f (a₁ * a₂) = f a₁ * f a₂ := is_mul_hom.hom_mul _ _ f a₁ a₂
+
+proposition is_mul_hom_id [has_mul A] : is_mul_hom (@id A) :=
+is_mul_hom.mk (take a₁ a₂, rfl)
+
+proposition is_mul_hom_comp [has_mul A] [has_mul B] [has_mul C]
+  {f : B → C} {g : A → B} [is_mul_hom f] [is_mul_hom g] : is_mul_hom (f ∘ g) :=
+is_mul_hom.mk (take a₁ a₂, by esimp; rewrite *hom_mul)
+
+section group_A_B
+  variables [group A] [group B]
+
+  proposition hom_one (f : A → B) [is_mul_hom f] :
+    f (1 : A) = 1 :=
+  have f 1 * f 1 = f 1 * 1, by rewrite [-hom_mul f, *mul_one],
+  eq_of_mul_eq_mul_left' this
+
+  proposition hom_inv (f : A → B) [is_mul_hom f] (a : A) :
+    f (a⁻¹) = (f a)⁻¹ :=
+  have f (a⁻¹) * f a = 1, by rewrite [-hom_mul f, mul.left_inv, hom_one],
+  eq_inv_of_mul_eq_one this
+
+  proposition injective_hom_mul [group B] {f : A → B} [is_mul_hom f]
+      (H : ∀ x, f x = 1 → x = 1) :
+    injective f :=
+  take x₁ x₂,
+  suppose f x₁ = f x₂,
+  have f (x₁ * x₂⁻¹) = 1, by rewrite [hom_mul, hom_inv, this, mul.right_inv],
+  have x₁ * x₂⁻¹ = 1, from H _ this,
+  eq_of_mul_inv_eq_one this
+
+  proposition eq_one_of_injective_hom [group B] {f : A → B} [is_mul_hom f]
+      (injf : injective f) {a : A} (fa1 : f a = 1) :
+    a = 1 :=
+  have f a = f 1, by rewrite [fa1, hom_one],
+  show a = 1, from injf this
+end group_A_B
+
+/- modules -/
+
+structure is_module_hom [class] (R : Type) {M₁ M₂ : Type}
+  [has_scalar R M₁] [has_scalar R M₂] [has_add M₁] [has_add M₂]
+  (f : M₁ → M₂) extends is_add_hom f :=
+(hom_smul : ∀ r : R, ∀ a : M₁, f (r • a) = r • f a)
+
+section module_hom
+  variables {R : Type} {M₁ M₂ M₃ : Type}
+  variables [has_scalar R M₁] [has_scalar R M₂] [has_scalar R M₃]
+  variables [has_add M₁] [has_add M₂] [has_add M₃]
+  variables (g : M₂ → M₃) (f : M₁ → M₂) [is_module_hom R g] [is_module_hom R f]
+
+  proposition hom_smul (r : R) (a : M₁) : f (r • a) = r • f a :=
+  is_module_hom.hom_smul _ _ _ _ f r a
+
+  proposition is_module_hom_id : is_module_hom R (@id M₁) :=
+  is_module_hom.mk (λ a₁ a₂, rfl) (λ r a, rfl)
+
+  proposition is_module_hom_comp : is_module_hom R (g ∘ f) :=
+  is_module_hom.mk
+    (take a₁ a₂, by esimp; rewrite *hom_add)
+    (take r a, by esimp; rewrite [hom_smul f, hom_smul g])
+
+  proposition hom_smul_add_smul (a b : R) (u v : M₁) : f (a • u + b • v) = a • f u + b • f v :=
+  by rewrite [hom_add, +hom_smul f]
+end module_hom
+
+/- rings -/
+
+structure is_ring_hom [class] {R₁ R₂ : Type} [has_mul R₁] [has_mul R₂] [has_add R₁] [has_add R₂]
+    (f : R₁ → R₂) extends is_add_hom f, is_mul_hom f
+
+section semiring
+  variables {R₁ R₂ R₃ : Type} [semiring R₁] [semiring R₂] [semiring R₃]
+  variables (g : R₂ → R₃) (f : R₁ → R₂) [is_ring_hom g] [is_ring_hom f]
+
+  proposition is_ring_hom_id : is_ring_hom (@id R₁) :=
+  is_ring_hom.mk (λ a₁ a₂, rfl) (λ a₁ a₂, rfl)
+
+  proposition is_ring_hom_comp : is_ring_hom (g ∘ f) :=
+  is_ring_hom.mk
+    (take a₁ a₂, by esimp; rewrite *hom_add)
+    (take r a, by esimp; rewrite [hom_mul f, hom_mul g])
+
+  proposition hom_mul_add_mul (a b c d : R₁) : f (a * b + c * d) = f a * f b + f c * f d :=
+  by rewrite [hom_add, +hom_mul]
+end semiring

old_library/algebra/interval.lean

@@ -0,0 +1,187 @@
+/-
+Copyright (c) 2015 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+
+Notation for intervals and some properties.
+
+The mnemonic: o = open, c = closed, i = infinity. For example, Ioi a b is '(a, ∞).
+-/
+import .order data.set
+open set
+
+namespace interval
+
+section order_pair
+variables {A : Type} [order_pair A]
+
+definition Ioo (a b : A) : set A := {x | a < x ∧ x < b}
+definition Ioc (a b : A) : set A := {x | a < x ∧ x ≤ b}
+definition Ico (a b : A) : set A := {x | a ≤ x ∧ x < b}
+definition Icc (a b : A) : set A := {x | a ≤ x ∧ x ≤ b}
+definition Ioi (a : A)   : set A := {x | a < x}
+definition Ici (a : A)   : set A := {x | a ≤ x}
+definition Iio (b : A)   : set A := {x | x < b}
+definition Iic (b : A)   : set A := {x | x ≤ b}
+
+notation `'(` a `, ` b `)`     := Ioo a b
+notation `'(` a `, ` b `]`     := Ioc a b
+notation `'[` a `, ` b `)`     := Ico a b
+notation `'[` a `, ` b `]`     := Icc a b
+notation `'(` a `, ` `∞` `)`   := Ioi a
+notation `'[` a `, ` `∞` `)`   := Ici a
+notation `'(` `-∞` `, ` b `)`  := Iio b
+notation `'(` `-∞` `, ` b `]`  := Iic b
+
+variables a b : A
+
+proposition Ioi_inter_Iio : '(a, ∞) ∩ '(-∞, b) = '(a, b) := rfl
+proposition Ici_inter_Iio : '[a, ∞) ∩ '(-∞, b) = '[a, b) := rfl
+proposition Ioi_inter_Iic : '(a, ∞) ∩ '(-∞, b] = '(a, b] := rfl
+proposition Ioc_inter_Iic : '[a, ∞) ∩ '(-∞, b] = '[a, b] := rfl
+
+proposition Icc_self : '[a, a] = '{a} :=
+set.ext (take x, iff.intro
+  (suppose x ∈ '[a, a],
+    have x = a, from le.antisymm (and.right this) (and.left this),
+    show x ∈ '{a}, from mem_singleton_of_eq this)
+  (suppose x ∈ '{a},
+    have x = a, from eq_of_mem_singleton this,
+    show a ≤ x ∧ x ≤ a, from and.intro (eq.subst this !le.refl) (eq.subst this !le.refl)))
+
+proposition Icc_eq_empty {a b : A} (H : b < a) : '[a, b] = ∅ :=
+eq_empty_of_forall_not_mem
+  (take x, suppose x ∈ '[a, b],
+    have a ≤ b, from le.trans (and.left this) (and.right this),
+    not_le_of_gt H this)
+
+end order_pair
+
+section strong_order_pair
+
+variables {A : Type} [linear_strong_order_pair A]
+
+proposition compl_Ici (a : A) : -'[a, ∞) = '(-∞, a) :=
+ext (take x, iff.intro
+  (assume H, lt_of_not_ge H)
+  (assume H, not_le_of_gt H))
+
+proposition compl_Iic (a : A) : -'(-∞, a] = '(a, ∞) :=
+ext (take x, iff.intro
+  (assume H, lt_of_not_ge H)
+  (assume H, not_le_of_gt H))
+
+proposition compl_Ioi (a : A) : -'(a, ∞) = '(-∞, a] :=
+ext (take x, iff.intro
+  (assume H, le_of_not_gt H)
+  (assume H, not_lt_of_ge H))
+
+proposition compl_Iio (a : A) : -'(-∞, a) = '[a, ∞) :=
+ext (take x, iff.intro
+  (assume H, le_of_not_gt H)
+  (assume H, not_lt_of_ge H))
+
+proposition Icc_eq_Icc_union_Ioc {a b c : A} (H1 : a ≤ b) (H2 : b ≤ c) :
+  '[a, c] = '[a, b] ∪ '(b, c] :=
+set.ext (take x, iff.intro
+  (assume H3 :  x ∈ '[a, c],
+    or.elim (le_or_gt x b)
+      (suppose x ≤ b,
+         or.inl (and.intro (and.left H3) this))
+      (suppose x > b,
+         or.inr (and.intro this (and.right H3))))
+  (suppose x ∈ '[a, b] ∪ '(b, c],
+    or.elim this
+      (suppose x ∈ '[a, b],
+         and.intro (and.left this) (le.trans (and.right this) H2))
+      (suppose x ∈ '(b, c],
+         and.intro (le_of_lt (lt_of_le_of_lt H1 (and.left this))) (and.right this))))
+
+proposition singleton_union_Ioc {a b : A} (H : a ≤ b) : '{a} ∪ '(a, b] = '[a,b] :=
+by rewrite [-Icc_self, Icc_eq_Icc_union_Ioc !le.refl H]
+
+end strong_order_pair
+
+/- intervals of natural numbers -/
+
+namespace nat
+open nat eq.ops
+  variables m n : ℕ
+
+  proposition Ioc_eq_Icc_succ : '(m, n] = '[succ m, n] := rfl
+
+  proposition Ioo_eq_Ico_succ : '(m, n) = '[succ m, n) := rfl
+
+  proposition Ico_succ_eq_Icc : '[m, succ n) = '[m, n] :=
+  set.ext (take x, iff.intro
+    (assume H, and.intro (and.left H) (le_of_lt_succ (and.right H)))
+    (assume H, and.intro (and.left H) (lt_succ_of_le (and.right H))))
+
+  proposition Ioo_succ_eq_Ioc : '(m, succ n) = '(m, n] :=
+  set.ext (take x, iff.intro
+    (assume H, and.intro (and.left H) (le_of_lt_succ (and.right H)))
+    (assume H, and.intro (and.left H) (lt_succ_of_le (and.right H))))
+
+  proposition Ici_zero : '[(0 : nat), ∞) = univ :=
+  eq_univ_of_forall (take x, zero_le x)
+
+  proposition Icc_zero (n : ℕ) : '[0, n] = '(-∞, n] :=
+  have '[0, n] = '[0, ∞) ∩ '(-∞, n], from rfl,
+  by rewrite [this, Ici_zero, univ_inter]
+
+  proposition bij_on_add_Icc_zero (m n : ℕ) : bij_on (add m) ('[0, n]) ('[m, m+n]) :=
+  have mapsto : ∀₀ i ∈ '[0, n], m + i ∈ '[m, m+n], from
+    (take i, assume imem,
+      have H1 : m ≤ m + i, from !le_add_right,
+      have H2 : m + i ≤ m + n, from add_le_add_left (and.right imem) m,
+      show m + i ∈ '[m, m+n], from and.intro H1 H2),
+  have injon : inj_on (add m) ('[0, n]), from
+    (take i j, assume Hi Hj H, !eq_of_add_eq_add_left H),
+  have surjon : surj_on (add m) ('[0, n]) ('[m, m+n]), from
+    (take j, assume Hj : j ∈ '[m, m+n],
+      obtain lej jle, from Hj,
+      let i := j - m in
+      have ile : i ≤ n, from calc
+        j - m ≤ m + n - m : nat.sub_le_sub_right jle m
+          ... = n         : nat.add_sub_cancel_left,
+      have iadd : m + i = j, by rewrite add.comm; apply nat.sub_add_cancel lej,
+      exists.intro i (and.intro (and.intro !zero_le ile) iadd)),
+  bij_on.mk mapsto injon surjon
+end nat
+
+section nat -- put the instances in the intervals namespace
+open nat eq.ops
+  variables m n : ℕ
+
+  attribute [instance]
+  proposition nat.Iic_finite (n : ℕ) : finite '(-∞, n] :=
+  nat.induction_on n
+    (have '(-∞, 0] ⊆ '{0}, from λ x H, mem_singleton_of_eq (le.antisymm H !zero_le),
+      finite_subset this)
+    (take n, assume ih : finite '(-∞, n],
+      have '(-∞, succ n] ⊆ '(-∞, n] ∪ '{succ n},
+        by intro x H; rewrite [mem_union_iff, mem_singleton_iff]; apply le_or_eq_succ_of_le_succ H,
+        finite_subset this)
+
+  attribute [instance]
+  proposition nat.Iio_finite (n : ℕ) : finite '(-∞, n) :=
+  have '(-∞, n) ⊆ '(-∞, n], from λ x, le_of_lt,
+  finite_subset this
+
+  attribute [instance]
+  proposition nat.Icc_finite (m n : ℕ) : finite ('[m, n]) :=
+  have '[m, n] ⊆ '(-∞, n], from λ x H, and.right H,
+  finite_subset this
+
+  attribute [instance]
+  proposition nat.Ico_finite (m n : ℕ) : finite ('[m, n)) :=
+  have '[m, n) ⊆ '(-∞, n), from λ x H, and.right H,
+  finite_subset this
+
+  attribute [instance]
+  proposition nat.Ioc_finite (m n : ℕ) : finite '(m, n] :=
+  have '(m, n] ⊆ '(-∞, n], from λ x H, and.right H,
+  finite_subset this
+end nat
+
+end interval

old_library/algebra/lattice.lean

@@ -0,0 +1,148 @@
+/-
+Copyright (c) 2014 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+-/
+import .order
+
+variable {A : Type}
+
+/- lattices (we could split this to upper- and lower-semilattices, if needed) -/
+
+structure lattice [class] (A : Type) extends weak_order A :=
+(inf : A → A → A)
+(sup : A → A → A)
+(inf_le_left : ∀ a b, le (inf a b) a)
+(inf_le_right : ∀ a b, le (inf a b) b)
+(le_inf : ∀a b c, le c a → le c b → le c (inf a b))
+(le_sup_left : ∀ a b, le a (sup a b))
+(le_sup_right : ∀ a b, le b (sup a b))
+(sup_le : ∀ a b c, le a c → le b c → le (sup a b) c)
+
+definition inf := @lattice.inf
+definition sup := @lattice.sup
+infix ` ⊓ `:70 := inf
+infix ` ⊔ `:65 := sup
+
+section
+  variable [s : lattice A]
+  include s
+
+  theorem inf_le_left (a b : A) : a ⊓ b ≤ a := lattice.inf_le_left a b
+
+  theorem inf_le_right (a b : A) : a ⊓ b ≤ b := lattice.inf_le_right a b
+
+  theorem le_inf {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) : c ≤ a ⊓ b := lattice.le_inf a b c H₁ H₂
+
+  theorem le_sup_left (a b : A) : a ≤ a ⊔ b := lattice.le_sup_left a b
+
+  theorem le_sup_right (a b : A) : b ≤ a ⊔ b := lattice.le_sup_right a b
+
+  theorem sup_le {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) : a ⊔ b ≤ c := lattice.sup_le a b c H₁ H₂
+
+  /- inf -/
+
+  theorem eq_inf {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) (H₃ : ∀{d}, d ≤ a → d ≤ b → d ≤ c) :
+    c = a ⊓ b :=
+  le.antisymm (le_inf H₁ H₂) (H₃ (inf_le_left a b) (inf_le_right a b))
+
+  theorem inf.comm (a b : A) : a ⊓ b = b ⊓ a :=
+  eq_inf (inf_le_right a b) (inf_le_left a b) (λ c H₁ H₂, le_inf H₂ H₁)
+
+  theorem inf.assoc (a b c : A) : (a ⊓ b) ⊓ c = a ⊓ (b ⊓ c) :=
+  sorry
+  /-
+  begin
+    apply eq_inf,
+    { apply le.trans, apply inf_le_left, apply inf_le_left },
+    { apply le_inf, apply le.trans, apply inf_le_left, apply inf_le_right, apply inf_le_right },
+    { intros [d, H₁, H₂], apply le_inf, apply le_inf H₁, apply le.trans H₂, apply inf_le_left,
+      apply le.trans H₂, apply inf_le_right }
+  end
+  -/
+
+  theorem inf.left_comm (a b c : A) : a ⊓ (b ⊓ c) = b ⊓ (a ⊓ c) :=
+  binary.left_comm (@inf.comm A s) (@inf.assoc A s) a b c
+
+  theorem inf.right_comm (a b c : A) : (a ⊓ b) ⊓ c = (a ⊓ c) ⊓ b :=
+  binary.right_comm (@inf.comm A s) (@inf.assoc A s) a b c
+
+  theorem inf_self (a : A) : a ⊓ a = a :=
+  sorry -- by apply eq.symm; apply eq_inf (le.refl a) !le.refl; intros; assumption
+
+  theorem inf_eq_left {a b : A} (H : a ≤ b) : a ⊓ b = a :=
+  sorry -- by apply eq.symm; apply eq_inf !le.refl H; intros; assumption
+
+  theorem inf_eq_right {a b : A} (H : b ≤ a) : a ⊓ b = b :=
+  eq.subst (inf.comm b a) (inf_eq_left H)
+
+  /- sup -/
+
+  theorem eq_sup {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) (H₃ : ∀{d}, a ≤ d → b ≤ d → c ≤ d) :
+    c = a ⊔ b :=
+  le.antisymm (H₃ (le_sup_left a b) (le_sup_right a b)) (sup_le H₁ H₂)
+
+  theorem sup.comm (a b : A) : a ⊔ b = b ⊔ a :=
+  eq_sup (le_sup_right a b) (le_sup_left a b) (λ c H₁ H₂, sup_le H₂ H₁)
+
+  theorem sup.assoc (a b c : A) : (a ⊔ b) ⊔ c = a ⊔ (b ⊔ c) :=
+  sorry
+  /-
+  begin
+    apply eq_sup,
+    { apply le.trans, apply le_sup_left a b, apply le_sup_left },
+    { apply sup_le, apply le.trans, apply le_sup_right a b, apply le_sup_left, apply le_sup_right },
+    { intros [d, H₁, H₂], apply sup_le, apply sup_le H₁, apply le.trans !le_sup_left H₂,
+      apply le.trans !le_sup_right H₂}
+  end
+  -/
+
+  theorem sup.left_comm (a b c : A) : a ⊔ (b ⊔ c) = b ⊔ (a ⊔ c) :=
+  binary.left_comm (@sup.comm A s) (@sup.assoc A s) a b c
+
+  theorem sup.right_comm (a b c : A) : (a ⊔ b) ⊔ c = (a ⊔ c) ⊔ b :=
+  binary.right_comm (@sup.comm A s) (@sup.assoc A s) a b c
+
+  theorem sup_self (a : A) : a ⊔ a = a :=
+  sorry -- by apply eq.symm; apply eq_sup (le.refl a) !le.refl; intros; assumption
+
+  theorem sup_eq_left {a b : A} (H : b ≤ a) : a ⊔ b = a :=
+  sorry -- by apply eq.symm; apply eq_sup !le.refl H; intros; assumption
+
+  theorem sup_eq_right {a b : A} (H : a ≤ b) : a ⊔ b = b :=
+  eq.subst (sup.comm b a) (sup_eq_left H)
+end
+
+/- lattice instances  -/
+
+attribute [instance]
+definition lattice_Prop : lattice Prop :=
+⦃ lattice, weak_order_Prop,
+  inf          := and,
+  le_inf       := take a b c Ha Hb Hc, and.intro (Ha Hc) (Hb Hc),
+  inf_le_left  := @and.elim_left,
+  inf_le_right := @and.elim_right,
+  sup          := or,
+  sup_le       := @or.rec,
+  le_sup_left  := @or.intro_left,
+  le_sup_right := @or.intro_right
+⦄
+
+attribute [instance]
+definition lattice_fun (A B : Type) [lattice B] : lattice (A → B) :=
+⦃ lattice, weak_order_fun A B,
+  inf          := λf g x, inf (f x) (g x),
+  le_inf       := take f g h Hf Hg x, le_inf (Hf x) (Hg x),
+  inf_le_left  := take f g x, inf_le_left (f x) (g x),
+  inf_le_right := take f g x, inf_le_right (f x) (g x),
+  sup          := λf g x, sup (f x) (g x),
+  sup_le       := take f g h Hf Hg x, sup_le (Hf x) (Hg x),
+  le_sup_left  := take f g x, le_sup_left (f x) (g x),
+  le_sup_right := take t g x, le_sup_right (t x) (g x)
+⦄
+
+/-
+  Should we add a trans-instance from total orders to lattices?
+  If we added we should add it with lower priority:
+    Prop is added as a lattice, but in the classical case it is a total order!
+-/

old_library/algebra/module.lean

@@ -0,0 +1,78 @@
+/-
+Copyright (c) 2015 Nathaniel Thomas. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Nathaniel Thomas, Jeremy Avigad
+
+Modules and vector spaces over a ring.
+
+(We use "left_module," which is more precise, because "module" is a keyword.)
+-/
+import algebra.field
+
+structure has_scalar [class] (F V : Type) :=
+(smul : F → V → V)
+
+infixl ` • `:73 := has_scalar.smul
+
+/- modules over a ring -/
+
+structure left_module [class] (R M : Type) [ringR : ring R]
+  extends has_scalar R M, add_comm_group M :=
+(smul_left_distrib : ∀ (r : R) (x y : M), smul r (add x y) = (add (smul r x) (smul r y)))
+(smul_right_distrib : ∀ (r s : R) (x : M), smul (ring.add r s) x = (add (smul r x) (smul s x)))
+(mul_smul : ∀ r s x, smul (mul r s) x = smul r (smul s x))
+(one_smul : ∀ x, smul one x = x)
+
+section left_module
+  variables {R M : Type}
+  variable  [ringR : ring R]
+  variable  [moduleRM : left_module R M]
+  include   ringR moduleRM
+
+  -- Note: the anonymous include does not work in the propositions below.
+
+  proposition smul_left_distrib (a : R) (u v : M) : a • (u + v) = a • u + a • v :=
+  left_module.smul_left_distrib ringR a u v
+
+  proposition smul_right_distrib (a b : R) (u : M) : (a + b) • u = a • u + b • u :=
+  left_module.smul_right_distrib ringR a b u
+
+  proposition mul_smul (a : R) (b : R) (u : M) : (a * b) • u = a • (b • u) :=
+  left_module.mul_smul ringR a b u
+
+  proposition one_smul (u : M) : (1 : R) • u = u := left_module.one_smul ringR u
+
+  proposition zero_smul (u : M) : (0 : R) • u = 0 :=
+  sorry
+  /-
+  have (0 : R) • u + 0 • u = 0 • u + 0, by rewrite [-smul_right_distrib, *add_zero],
+  !add.left_cancel this
+  -/
+
+  proposition smul_zero (a : R) : a • (0 : M) = 0 :=
+  sorry
+  /-
+  have a • (0:M) + a • 0 = a • 0 + 0, by rewrite [-smul_left_distrib, *add_zero],
+  !add.left_cancel this
+  -/
+
+  proposition neg_smul (a : R) (u : M) : (-a) • u = - (a • u) :=
+  sorry -- eq_neg_of_add_eq_zero (by rewrite [-smul_right_distrib, add.left_inv, zero_smul])
+
+  proposition neg_one_smul (u : M) : -(1 : R) • u = -u :=
+  sorry -- by rewrite [neg_smul, one_smul]
+
+  proposition smul_neg (a : R) (u : M) : a • (-u) = -(a • u) :=
+  sorry -- by rewrite [-neg_one_smul, -mul_smul, mul_neg_one_eq_neg, neg_smul]
+
+  proposition smul_sub_left_distrib (a : R) (u v : M) : a • (u - v) = a • u - a • v :=
+  sorry -- by rewrite [sub_eq_add_neg, smul_left_distrib, smul_neg]
+
+  proposition sub_smul_right_distrib (a b : R) (v : M) : (a - b) • v = a • v - b • v :=
+  sorry -- by rewrite [sub_eq_add_neg, smul_right_distrib, neg_smul]
+end left_module
+
+/- vector spaces -/
+
+structure vector_space [class] (F V : Type) [fieldF : field F]
+  extends left_module F V

old_library/algebra/monotone.lean

@@ -0,0 +1,477 @@
+/-
+Copyright (c) 2016 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+
+Weak and strict order preserving maps.
+
+TODO: we will probably eventually want versions restricted to smaller domains,
+"nondecreasing_on" etc. Maybe we can do this with subtypes.
+-/
+import .order
+open eq function
+
+variables {A B C : Type}
+
+section
+  variables [weak_order A] [weak_order B] [weak_order C]
+
+  definition nondecreasing (f : A → B) : Prop := ∀ ⦃a₁ a₂⦄, a₁ ≤ a₂ → f a₁ ≤ f a₂
+
+  definition nonincreasing (f : A → B) : Prop := ∀ ⦃a₁ a₂⦄, a₁ ≤ a₂ → f a₁ ≥ f a₂
+
+  theorem nondecreasing_id : nondecreasing (@id A) := take a₁ a₂, assume H, H
+
+  theorem nondecreasing_comp_nondec_nondec {g : B → C} {f : A → B}
+      (Hg : nondecreasing g) (Hf : nondecreasing f) : nondecreasing (g ∘ f) :=
+  take a₁ a₂, assume H, Hg (Hf H)
+
+  theorem nondecreasing_comp_noninc_noninc {g : B → C} {f : A → B}
+      (Hg : nonincreasing g) (Hf : nonincreasing f) : nondecreasing (g ∘ f) :=
+  take a₁ a₂, assume H, Hg (Hf H)
+
+  theorem nonincreasing_comp_noninc_nondec {g : B → C} {f : A → B}
+      (Hg : nonincreasing g) (Hf : nondecreasing f) : nonincreasing (g ∘ f) :=
+  take a₁ a₂, assume H, Hg (Hf H)
+
+  theorem nonincreasing_comp_nondec_noninc {g : B → C} {f : A → B}
+      (Hg : nondecreasing g) (Hf : nonincreasing f) : nonincreasing (g ∘ f) :=
+  take a₁ a₂, assume H, Hg (Hf H)
+end
+
+section
+  variables [strict_order A] [strict_order B] [strict_order C]
+
+  definition strictly_increasing (f : A → B) : Prop :=
+  ∀ ⦃a₁ a₂⦄, a₁ < a₂ → f a₁ < f a₂
+
+  definition strictly_decreasing (f : A → B) : Prop :=
+  ∀ ⦃a₁ a₂⦄, a₁ < a₂ → f a₁ > f a₂
+
+  theorem strictly_increasing_id : strictly_increasing (@id A) := take a₁ a₂, assume H, H
+
+  theorem strictly_increasing_comp_inc_inc {g : B → C} {f : A → B}
+      (Hg : strictly_increasing g) (Hf : strictly_increasing f) : strictly_increasing (g ∘ f) :=
+  take a₁ a₂, assume H, Hg (Hf H)
+
+  theorem strictly_increasing_comp_dec_dec {g : B → C} {f : A → B}
+      (Hg : strictly_decreasing g) (Hf : strictly_decreasing f) : strictly_increasing (g ∘ f) :=
+  take a₁ a₂, assume H, Hg (Hf H)
+
+  theorem strictly_decreasing_comp_inc_dec {g : B → C} {f : A → B}
+      (Hg : strictly_increasing g) (Hf : strictly_decreasing f) : strictly_decreasing (g ∘ f) :=
+  take a₁ a₂, assume H, Hg (Hf H)
+
+  theorem strictly_decreasing_comp_dec_inc {g : B → C} {f : A → B}
+      (Hg : strictly_decreasing g) (Hf : strictly_increasing f) : strictly_decreasing (g ∘ f) :=
+  take a₁ a₂, assume H, Hg (Hf H)
+end
+
+section
+  variables [strong_order_pair A] [strong_order_pair B]
+
+  theorem nondecreasing_of_strictly_increasing {f : A → B} (H : strictly_increasing f) :
+    nondecreasing f :=
+  take a₁ a₂, suppose a₁ ≤ a₂,
+  show f a₁ ≤ f a₂, from or.elim (lt_or_eq_of_le this)
+    (suppose a₁ < a₂, le_of_lt (H this))
+    (suppose a₁ = a₂, le_of_eq (congr_arg f this))
+
+  theorem nonincreasing_of_strictly_decreasing {f : A → B} (H : strictly_decreasing f) :
+    nonincreasing f :=
+  take a₁ a₂, suppose a₁ ≤ a₂,
+  show f a₁ ≥ f a₂, from or.elim (lt_or_eq_of_le this)
+    (suppose a₁ < a₂, le_of_lt (H this))
+    (suppose a₁ = a₂, le_of_eq (congr_arg f (symm this)))
+end
+
+section
+  variables [linear_strong_order_pair A] [linear_strong_order_pair B] [linear_strong_order_pair C]
+
+  theorem lt_of_strictly_increasing {f : A → B} {a₁ a₂ : A} (H : strictly_increasing f)
+    (H' : f a₁ < f a₂) : a₁ < a₂ :=
+  lt_of_not_ge (suppose a₂ ≤ a₁,
+    have f a₂ ≤ f a₁, from nondecreasing_of_strictly_increasing H this,
+    show false, from not_le_of_gt H' this)
+
+  theorem lt_iff_of_strictly_increasing {f : A → B} (a₁ a₂ : A) (H : strictly_increasing f) :
+    f a₁ < f a₂ ↔ a₁ < a₂ :=
+  iff.intro (lt_of_strictly_increasing H) (@H a₁ a₂)
+
+  theorem le_of_strictly_increasing {f : A → B} {a₁ a₂ : A} (H : strictly_increasing f)
+    (H' : f a₁ ≤ f a₂) : a₁ ≤ a₂ :=
+  le_of_not_gt (suppose a₂ < a₁, not_le_of_gt (H this) H')
+
+  theorem le_iff_of_strictly_increasing {f : A → B} (a₁ a₂ : A) (H : strictly_increasing f) :
+    f a₁ ≤ f a₂ ↔ a₁ ≤ a₂ :=
+  iff.intro (le_of_strictly_increasing H) (λ H', nondecreasing_of_strictly_increasing H H')
+
+  theorem lt_of_strictly_decreasing {f : A → B} {a₁ a₂ : A} (H : strictly_decreasing f)
+    (H' : f a₁ > f a₂) : a₁ < a₂ :=
+  lt_of_not_ge (suppose a₂ ≤ a₁,
+    have f a₂ ≥ f a₁, from nonincreasing_of_strictly_decreasing H this,
+    show false, from not_le_of_gt H' this)
+
+  theorem gt_iff_of_strictly_decreasing {f : A → B} (a₁ a₂ : A) (H : strictly_decreasing f) :
+    f a₁ > f a₂ ↔ a₁ < a₂ :=
+  iff.intro (lt_of_strictly_decreasing H) (@H a₁ a₂)
+
+  theorem le_of_strictly_decreasing {f : A → B} {a₁ a₂ : A} (H : strictly_decreasing f)
+    (H' : f a₁ ≥ f a₂) : a₁ ≤ a₂ :=
+  le_of_not_gt (suppose a₂ < a₁, not_le_of_gt (H this) H')
+
+  theorem ge_iff_of_strictly_decreasing {f : A → B} (a₁ a₂ : A) (H : strictly_decreasing f) :
+    f a₁ ≥ f a₂ ↔ a₁ ≤ a₂ :=
+  iff.intro (le_of_strictly_decreasing H) (λ H', nonincreasing_of_strictly_decreasing H H')
+
+  theorem strictly_increasing_of_left_inverse {g : B → A} {f : A → B} (H : left_inverse g f)
+      (H' : strictly_increasing g) : strictly_increasing f :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ < a₂,
+  have g (f a₁) < g (f a₂), by rewrite *H; apply this,
+  lt_of_strictly_increasing H' this
+  -/
+
+  theorem strictly_decreasing_of_left_inverse {g : B → A} {f : A → B} (H : left_inverse g f)
+      (H' : strictly_decreasing g) : strictly_decreasing f :=
+  sorry
+  /-
+  take b₁ b₂, suppose b₁ < b₂,
+  have g (f b₁) < g (f b₂), by rewrite *H; apply this,
+  lt_of_strictly_decreasing H' this
+  -/
+
+  theorem nondecreasing_of_left_inverse {g : B → A} {f : A → B} (H : left_inverse g f)
+      (H' : strictly_increasing g) : nondecreasing f :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ ≤ a₂,
+  have g (f a₁) ≤ g (f a₂), by rewrite *H; apply this,
+  le_of_strictly_increasing H' this
+  -/
+
+  theorem nonincreasing_of_left_inverse {g : B → A} {f : A → B} (H : left_inverse g f)
+      (H' : strictly_decreasing g) : nonincreasing f :=
+  sorry
+  /-
+  take b₁ b₂, suppose b₁ ≤ b₂,
+  have g (f b₁) ≤ g (f b₂), by rewrite *H; apply this,
+  le_of_strictly_decreasing H' this
+  -/
+end
+
+/- composition rules for strict orders -/
+
+section
+  variables [strict_order A] [strict_order B] [strict_order C]
+
+  theorem strictly_increasing_of_strictly_increasing_comp_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : strictly_increasing h) (H₃ : strictly_increasing (g ∘ f)) :
+    strictly_increasing f :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ < a₂,
+  have h (g (f a₁)) < h (g (f a₂)), from H₂ (H₃ this),
+  show f a₁ < f a₂, by rewrite *H₁ at this; apply this
+  -/
+
+  theorem strictly_decreasing_of_strictly_increasing_comp_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : strictly_decreasing h) (H₃ : strictly_increasing (g ∘ f)) :
+    strictly_decreasing f :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ < a₂,
+  have h (g (f a₁)) > h (g (f a₂)), from H₂ (H₃ this),
+  show f a₁ > f a₂, by rewrite *H₁ at this; apply this
+  -/
+
+  theorem strictly_decreasing_of_strictly_decreasing_comp_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : strictly_increasing h) (H₃ : strictly_decreasing (g ∘ f)) :
+    strictly_decreasing f :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ < a₂,
+  have h (g (f a₁)) > h (g (f a₂)), from H₂ (H₃ this),
+  show f a₁ > f a₂, by rewrite *H₁ at this; apply this
+  -/
+
+  theorem strictly_increasing_of_strictly_decreasing_comp_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : strictly_decreasing h) (H₃ : strictly_decreasing (g ∘ f)) :
+    strictly_increasing f :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ < a₂,
+  have h (g (f a₁)) < h (g (f a₂)), from H₂ (H₃ this),
+  show f a₁ < f a₂, by rewrite *H₁ at this; apply this
+  -/
+
+  theorem strictly_increasing_of_strictly_decreasing_comp_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : strictly_decreasing h) (H₃ : strictly_decreasing (g ∘ f)) :
+    strictly_increasing g :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ < a₂,
+  have g (f (h a₁)) < g (f (h a₂)), from H₃ (H₂ this),
+  show g a₁ < g a₂, by rewrite *H₁ at this; apply this
+  -/
+
+  theorem strictly_decreasing_of_strictly_decreasing_comp_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : strictly_increasing h) (H₃ : strictly_decreasing (g ∘ f)) :
+    strictly_decreasing g :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ < a₂,
+  have g (f (h a₁)) > g (f (h a₂)), from H₃ (H₂ this),
+  show g a₁ > g a₂, by rewrite *H₁ at this; apply this
+  -/
+
+  theorem strictly_increasing_of_strictly_increasing_comp_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : strictly_increasing h) (H₃ : strictly_increasing (g ∘ f)) :
+    strictly_increasing g :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ < a₂,
+  have g (f (h a₁)) < g (f (h a₂)), from H₃ (H₂ this),
+  show g a₁ < g a₂, by rewrite *H₁ at this; apply this
+  -/
+
+  theorem strictly_decreasing_of_strictly_increasing_comp_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : strictly_decreasing h) (H₃ : strictly_increasing (g ∘ f)) :
+    strictly_decreasing g :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ < a₂,
+  have g (f (h a₁)) > g (f (h a₂)), from H₃ (H₂ this),
+  show g a₁ > g a₂, by rewrite *H₁ at this; apply this
+  -/
+end
+
+section
+  variables [strict_order A] [linear_strong_order_pair B] [linear_strong_order_pair C]
+
+  theorem strictly_increasing_comp_iff_strictly_increasing_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : strictly_increasing h) :
+    strictly_increasing (g ∘ f) ↔ strictly_increasing f :=
+  have H₃ : strictly_increasing g, from strictly_increasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (strictly_increasing_of_strictly_increasing_comp_right H₁ H₂)
+    (strictly_increasing_comp_inc_inc H₃)
+
+  theorem strictly_increasing_comp_iff_strictly_decreasing_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : strictly_decreasing h) :
+    strictly_increasing (g ∘ f) ↔ strictly_decreasing f :=
+  have H₃ : strictly_decreasing g, from strictly_decreasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (strictly_decreasing_of_strictly_increasing_comp_right H₁ H₂)
+    (strictly_increasing_comp_dec_dec H₃)
+
+  theorem strictly_decreasing_comp_iff_strictly_decreasing_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : strictly_increasing h) :
+    strictly_decreasing (g ∘ f) ↔ strictly_decreasing f :=
+  have H₃ : strictly_increasing g, from strictly_increasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (strictly_decreasing_of_strictly_decreasing_comp_right H₁ H₂)
+    (strictly_decreasing_comp_inc_dec H₃)
+
+  theorem strictly_decreasing_comp_iff_strictly_increasing_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : strictly_decreasing h) :
+    strictly_decreasing (g ∘ f) ↔ strictly_increasing f :=
+  have H₃ : strictly_decreasing g, from strictly_decreasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (strictly_increasing_of_strictly_decreasing_comp_right H₁ H₂)
+    (strictly_decreasing_comp_dec_inc H₃)
+end
+
+section
+  variables [linear_strong_order_pair A] [linear_strong_order_pair B] [strict_order C]
+
+  theorem strictly_increasing_comp_iff_strinctly_increasing_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : strictly_increasing f) :
+    strictly_increasing (g ∘ f) ↔ strictly_increasing g :=
+  have H₃ : strictly_increasing h, from strictly_increasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (strictly_increasing_of_strictly_increasing_comp_left H₁ H₃)
+    (λ H, strictly_increasing_comp_inc_inc H H₂)
+
+  theorem strictly_increasing_comp_iff_strictly_decreasing_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : strictly_decreasing f) :
+    strictly_increasing (g ∘ f) ↔ strictly_decreasing g :=
+  have H₃ : strictly_decreasing h, from strictly_decreasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (strictly_decreasing_of_strictly_increasing_comp_left H₁ H₃)
+    (λ H, strictly_increasing_comp_dec_dec H H₂)
+
+  theorem strictly_decreasing_comp_iff_strictly_increasing_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : strictly_decreasing f) :
+    strictly_decreasing (g ∘ f) ↔ strictly_increasing g :=
+  have H₃ : strictly_decreasing h, from strictly_decreasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (strictly_increasing_of_strictly_decreasing_comp_left H₁ H₃)
+    (λ H, strictly_decreasing_comp_inc_dec H H₂)
+
+  theorem strictly_decreasing_comp_iff_strictly_decreasing_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : strictly_increasing f) :
+    strictly_decreasing (g ∘ f) ↔ strictly_decreasing g :=
+  have H₃ : strictly_increasing h, from strictly_increasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (strictly_decreasing_of_strictly_decreasing_comp_left H₁ H₃)
+    (λ H, strictly_decreasing_comp_dec_inc H H₂)
+end
+
+/- composition rules for weak orders -/
+
+section
+  variables [weak_order A] [weak_order B] [weak_order C]
+
+  theorem nondecreasing_of_nondecreasing_comp_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : nondecreasing h) (H₃ : nondecreasing (g ∘ f)) :
+    nondecreasing f :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ ≤ a₂,
+  have h (g (f a₁)) ≤ h (g (f a₂)), from H₂ (H₃ this),
+  show f a₁ ≤ f a₂, by rewrite *H₁ at this; apply this
+  -/
+
+  theorem nonincreasing_of_nondecreasing_comp_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : nonincreasing h) (H₃ : nondecreasing (g ∘ f)) :
+    nonincreasing f :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ ≤ a₂,
+  have h (g (f a₁)) ≥ h (g (f a₂)), from H₂ (H₃ this),
+  show f a₁ ≥ f a₂, by rewrite *H₁ at this; apply this
+  -/
+
+  theorem nonincreasing_of_nonincreasing_comp_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : nondecreasing h) (H₃ : nonincreasing (g ∘ f)) :
+    nonincreasing f :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ ≤ a₂,
+  have h (g (f a₁)) ≥ h (g (f a₂)), from H₂ (H₃ this),
+  show f a₁ ≥ f a₂, by rewrite *H₁ at this; apply this
+  -/
+
+  theorem nondecreasing_of_nonincreasing_comp_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : nonincreasing h) (H₃ : nonincreasing (g ∘ f)) :
+    nondecreasing f :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ ≤ a₂,
+  have h (g (f a₁)) ≤ h (g (f a₂)), from H₂ (H₃ this),
+  show f a₁ ≤ f a₂, by rewrite *H₁ at this; apply this
+  -/
+
+  theorem nondecreasing_of_nondecreasing_comp_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : nondecreasing h) (H₃ : nondecreasing (g ∘ f)) :
+    nondecreasing g :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ ≤ a₂,
+  have g (f (h a₁)) ≤ g (f (h a₂)), from H₃ (H₂ this),
+  show g a₁ ≤ g a₂, by rewrite *H₁ at this; apply this
+  -/
+
+  theorem nonincreasing_of_nondecreasing_comp_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : nonincreasing h) (H₃ : nondecreasing (g ∘ f)) :
+    nonincreasing g :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ ≤ a₂,
+  have g (f (h a₁)) ≥ g (f (h a₂)), from H₃ (H₂ this),
+  show g a₁ ≥ g a₂, by rewrite *H₁ at this; apply this
+  -/
+
+  theorem nondecreasing_of_nonincreasing_comp_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : nonincreasing h) (H₃ : nonincreasing (g ∘ f)) :
+    nondecreasing g :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ ≤ a₂,
+  have g (f (h a₁)) ≤ g (f (h a₂)), from H₃ (H₂ this),
+  show g a₁ ≤ g a₂, by rewrite *H₁ at this; apply this
+  -/
+  theorem nonincreasing_of_nonincreasing_comp_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : nondecreasing h) (H₃ : nonincreasing (g ∘ f)) :
+    nonincreasing g :=
+  sorry
+  /-
+  take a₁ a₂, suppose a₁ ≤ a₂,
+  have g (f (h a₁)) ≥ g (f (h a₂)), from H₃ (H₂ this),
+  show g a₁ ≥ g a₂, by rewrite *H₁ at this; apply this
+  -/
+end
+
+section
+  variables [weak_order A] [linear_strong_order_pair B] [linear_strong_order_pair C]
+
+  theorem nondecreasing_comp_iff_nondecreasing_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : strictly_increasing h) :
+    nondecreasing (g ∘ f) ↔ nondecreasing f :=
+  have H₃ : nondecreasing g, from nondecreasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (nondecreasing_of_nondecreasing_comp_right H₁ (nondecreasing_of_strictly_increasing H₂))
+    (nondecreasing_comp_nondec_nondec H₃)
+
+  theorem nondecreasing_comp_iff_nonincreasing_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : strictly_decreasing h) :
+    nondecreasing (g ∘ f) ↔ nonincreasing f :=
+  have H₃ : nonincreasing g, from nonincreasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (nonincreasing_of_nondecreasing_comp_right H₁ (nonincreasing_of_strictly_decreasing H₂))
+    (nondecreasing_comp_noninc_noninc H₃)
+
+  theorem nonincreasing_comp_iff_nonincreasing_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : strictly_increasing h) :
+    nonincreasing (g ∘ f) ↔ nonincreasing f :=
+  have H₃ : nondecreasing g, from nondecreasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (nonincreasing_of_nonincreasing_comp_right H₁ (nondecreasing_of_strictly_increasing H₂))
+    (nonincreasing_comp_nondec_noninc H₃)
+
+  theorem nonincreasing_comp_iff_nondecreasing_right {g : B → C} {f : A → B} {h : C → B}
+      (H₁ : left_inverse h g) (H₂ : strictly_decreasing h) :
+    nonincreasing (g ∘ f) ↔ nondecreasing f :=
+  have H₃ : nonincreasing g, from nonincreasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (nondecreasing_of_nonincreasing_comp_right H₁ (nonincreasing_of_strictly_decreasing H₂))
+    (nonincreasing_comp_noninc_nondec H₃)
+end
+
+section
+  variables [linear_strong_order_pair A] [linear_strong_order_pair B] [weak_order C]
+
+  theorem nondecreasing_comp_iff_nondecreasing_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : strictly_increasing f) :
+    nondecreasing (g ∘ f) ↔ nondecreasing g :=
+  have H₃ : nondecreasing h, from nondecreasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (nondecreasing_of_nondecreasing_comp_left H₁ H₃)
+    (λ H, nondecreasing_comp_nondec_nondec H (nondecreasing_of_strictly_increasing H₂))
+
+  theorem nondecreasing_comp_iff_nonincreasing_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : strictly_decreasing f) :
+    nondecreasing (g ∘ f) ↔ nonincreasing g :=
+  have H₃ : nonincreasing h, from nonincreasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (nonincreasing_of_nondecreasing_comp_left H₁ H₃)
+    (λ H, nondecreasing_comp_noninc_noninc H (nonincreasing_of_strictly_decreasing H₂))
+
+  theorem nonincreasing_comp_iff_nondecreasing_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : strictly_decreasing f) :
+    nonincreasing (g ∘ f) ↔ nondecreasing g :=
+  have H₃ : nonincreasing h, from nonincreasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (nondecreasing_of_nonincreasing_comp_left H₁ H₃)
+    (λ H, nonincreasing_comp_nondec_noninc H (nonincreasing_of_strictly_decreasing H₂))
+
+  theorem nonincreasing_comp_iff_nonincreasing_left {g : B → C} {f : A → B} {h : B → A}
+      (H₁ : left_inverse f h) (H₂ : strictly_increasing f) :
+    nonincreasing (g ∘ f) ↔ nonincreasing g :=
+  have H₃ : nondecreasing h, from nondecreasing_of_left_inverse H₁ H₂,
+  iff.intro
+    (nonincreasing_of_nonincreasing_comp_left H₁ H₃)
+    (λ H, nonincreasing_comp_noninc_nondec H (nondecreasing_of_strictly_increasing H₂))
+end

old_library/algebra/order.lean

@@ -0,0 +1,523 @@
+/-
+Copyright (c) 2014 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+
+Weak orders "≤", strict orders "<", and structures that include both.
+-/
+import logic.eq logic.connectives algebra.binary algebra.priority
+open eq function
+
+variables {A : Type}
+
+/- weak orders -/
+
+structure weak_order [class] (A : Type) extends has_le A :=
+(le_refl : ∀a, le a a)
+(le_trans : ∀a b c, le a b → le b c → le a c)
+(le_antisymm : ∀a b, le a b → le b a → a = b)
+
+section
+  variables [weak_order A]
+
+  attribute [refl]
+  theorem le.refl (a : A) : a ≤ a := weak_order.le_refl a
+
+  theorem le_of_eq {a b : A} (H : a = b) : a ≤ b := H ▸ le.refl a
+
+  attribute [trans]
+  theorem le.trans {a b c : A} : a ≤ b → b ≤ c → a ≤ c := weak_order.le_trans a b c
+
+  attribute [trans]
+  theorem ge.trans {a b c : A} (H1 : a ≥ b) (H2: b ≥ c) : a ≥ c := le.trans H2 H1
+
+  theorem le.antisymm {a b : A} : a ≤ b → b ≤ a → a = b := weak_order.le_antisymm a b
+
+  -- Alternate syntax. (Abbreviations do not migrate well.)
+  theorem eq_of_le_of_ge {a b : A} : a ≤ b → b ≤ a → a = b := le.antisymm
+end
+
+structure linear_weak_order [class] (A : Type) extends weak_order A :=
+(le_total : ∀a b, le a b ∨ le b a)
+
+section
+  variables [linear_weak_order A]
+
+  theorem le.total (a b : A) : a ≤ b ∨ b ≤ a := linear_weak_order.le_total a b
+
+  theorem le_of_not_ge {a b : A} (H : ¬ a ≥ b) : a ≤ b := or.resolve_left (le.total b a) H
+end
+
+/- strict orders -/
+
+structure strict_order [class] (A : Type) extends has_lt A :=
+(lt_irrefl : ∀a, ¬ lt a a)
+(lt_trans : ∀a b c, lt a b → lt b c → lt a c)
+
+section
+  variable [strict_order A]
+
+  theorem lt.irrefl (a : A) : ¬ a < a := strict_order.lt_irrefl a
+  theorem not_lt_self (a : A) : ¬ a < a := lt.irrefl a   -- alternate syntax
+
+  theorem lt_self_iff_false (a : A) : a < a ↔ false :=
+  iff_false_intro (lt.irrefl a)
+
+  attribute [trans]
+  theorem lt.trans {a b c : A} : a < b → b < c → a < c := strict_order.lt_trans a b c
+
+  attribute [trans]
+  theorem gt.trans {a b c : A} (H1 : a > b) (H2: b > c) : a > c := lt.trans H2 H1
+
+  theorem ne_of_lt {a b : A} (lt_ab : a < b) : a ≠ b :=
+  assume eq_ab : a = b,
+  show false, from lt.irrefl b (eq_ab ▸ lt_ab)
+
+  theorem ne_of_gt {a b : A} (gt_ab : a > b) : a ≠ b :=
+  ne.symm (ne_of_lt gt_ab)
+
+  theorem lt.asymm {a b : A} (H : a < b) : ¬ b < a :=
+  assume H1 : b < a, lt.irrefl _ (lt.trans H H1)
+
+  theorem not_lt_of_gt {a b : A} (H : a > b) : ¬ a < b := lt.asymm H    -- alternate syntax
+end
+
+/- well-founded orders -/
+
+structure wf_strict_order [class] (A : Type) extends strict_order A :=
+(wf_rec : ∀P : A → Type, (∀x, (∀y, lt y x → P y) → P x) → ∀x, P x)
+
+definition wf.rec_on {A : Type} [s : wf_strict_order A] {P : A → Type}
+    (x : A) (H : ∀x, (∀y, wf_strict_order.lt y x → P y) → P x) : P x :=
+wf_strict_order.wf_rec P H x
+
+theorem wf.ind_on.{u v} {A : Type.{u}} [s : wf_strict_order.{u 0} A] {P : A → Prop}
+    (x : A) (H : ∀x, (∀y, wf_strict_order.lt y x → P y) → P x) : P x :=
+wf.rec_on x H
+
+/- structures with a weak and a strict order -/
+
+structure order_pair [class] (A : Type) extends weak_order A, has_lt A :=
+(le_of_lt : ∀ a b, lt a b → le a b)
+(lt_of_lt_of_le : ∀ a b c, lt a b → le b c → lt a c)
+(lt_of_le_of_lt : ∀ a b c, le a b → lt b c → lt a c)
+(lt_irrefl : ∀ a, ¬ lt a a)
+
+section
+  variable [s : order_pair A]
+  variables {a b c : A}
+  include s
+
+  theorem le_of_lt : a < b → a ≤ b := order_pair.le_of_lt a b
+
+  attribute [trans]
+  theorem lt_of_lt_of_le : a < b → b ≤ c → a < c := order_pair.lt_of_lt_of_le a b c
+
+  attribute [trans]
+  theorem lt_of_le_of_lt : a ≤ b → b < c → a < c := order_pair.lt_of_le_of_lt a b c
+
+  private theorem lt_irrefl (s' : order_pair A) (a : A) : ¬ a < a := order_pair.lt_irrefl a
+
+  private theorem lt_trans (s' : order_pair A) (a b c: A) (lt_ab : a < b) (lt_bc : b < c) : a < c :=
+    lt_of_lt_of_le lt_ab (le_of_lt lt_bc)
+
+  attribute [instance]
+  definition order_pair.to_strict_order : strict_order A :=
+  ⦃ strict_order, s, lt_irrefl := lt_irrefl s, lt_trans := lt_trans s ⦄
+
+  attribute [trans]
+  theorem gt_of_gt_of_ge (H1 : a > b) (H2 : b ≥ c) : a > c := lt_of_le_of_lt H2 H1
+
+  attribute [trans]
+  theorem gt_of_ge_of_gt (H1 : a ≥ b) (H2 : b > c) : a > c := lt_of_lt_of_le H2 H1
+
+  theorem not_le_of_gt (H : a > b) : ¬ a ≤ b :=
+  assume H1 : a ≤ b,
+  lt.irrefl _ (lt_of_lt_of_le H H1)
+
+  theorem not_lt_of_ge (H : a ≥ b) : ¬ a < b :=
+  assume H1 : a < b,
+  lt.irrefl _ (lt_of_le_of_lt H H1)
+end
+
+structure strong_order_pair [class] (A : Type) extends weak_order A, has_lt A :=
+(le_iff_lt_or_eq : ∀a b, le a b ↔ lt a b ∨ a = b)
+(lt_irrefl : ∀ a, ¬ lt a a)
+
+section strong_order_pair
+  variable [strong_order_pair A]
+
+  theorem le_iff_lt_or_eq {a b : A} : a ≤ b ↔ a < b ∨ a = b :=
+  strong_order_pair.le_iff_lt_or_eq a b
+
+  theorem lt_or_eq_of_le {a b : A} (le_ab : a ≤ b) : a < b ∨ a = b :=
+  iff.mp le_iff_lt_or_eq le_ab
+
+  theorem le_of_lt_or_eq {a b : A} (lt_or_eq : a < b ∨ a = b) : a ≤ b :=
+  iff.mpr le_iff_lt_or_eq lt_or_eq
+
+  private theorem lt_irrefl' (a : A) : ¬ a < a :=
+  strong_order_pair.lt_irrefl a
+
+  private theorem le_of_lt' (a b : A) : a < b → a ≤ b :=
+  take Hlt, le_of_lt_or_eq (or.inl Hlt)
+
+  private theorem lt_iff_le_and_ne {a b : A} : a < b ↔ (a ≤ b ∧ a ≠ b) :=
+  iff.intro
+    (take Hlt, and.intro (le_of_lt_or_eq (or.inl Hlt)) (take Hab, absurd (Hab ▸ Hlt) (lt_irrefl' b)))
+    (take Hand,
+     have Hor : a < b ∨ a = b, from lt_or_eq_of_le (and.left Hand),
+     or_resolve_left Hor (and.right Hand))
+
+  theorem lt_of_le_of_ne {a b : A} : a ≤ b → a ≠ b → a < b :=
+  take H1 H2, iff.mpr lt_iff_le_and_ne (and.intro H1 H2)
+
+  private theorem ne_of_lt' {a b : A} (H : a < b) : a ≠ b :=
+  and.right ((iff.mp lt_iff_le_and_ne) H)
+
+  private theorem lt_of_lt_of_le' (a b c : A) : a < b → b ≤ c → a < c :=
+  assume lt_ab : a < b,
+  assume le_bc : b ≤ c,
+  have le_ac : a ≤ c, from le.trans (le_of_lt' _ _ lt_ab) le_bc,
+  have ne_ac : a ≠ c, from
+    assume eq_ac : a = c,
+    have le_ba : b ≤ a, from symm eq_ac ▸ le_bc,
+    have eq_ab : a = b, from le.antisymm  (le_of_lt' _ _ lt_ab) le_ba,
+    show false, from ne_of_lt' lt_ab eq_ab,
+  show a < c, from iff.mpr (lt_iff_le_and_ne) (and.intro le_ac ne_ac)
+
+  theorem lt_of_le_of_lt' (a b c : A) : a ≤ b → b < c → a < c :=
+  assume le_ab : a ≤ b,
+  assume lt_bc : b < c,
+  have le_ac : a ≤ c, from le.trans le_ab (le_of_lt' _ _ lt_bc),
+  have ne_ac : a ≠ c, from
+    assume eq_ac : a = c,
+    have le_cb : c ≤ b, from eq_ac ▸ le_ab,
+    have eq_bc : b = c, from le.antisymm  (le_of_lt' _ _ lt_bc) le_cb,
+    show false, from ne_of_lt' lt_bc eq_bc,
+  show a < c, from iff.mpr (lt_iff_le_and_ne) (and.intro le_ac ne_ac)
+end strong_order_pair
+
+attribute [instance]
+definition strong_order_pair.to_order_pair
+    [s : strong_order_pair A] : order_pair A :=
+⦃ order_pair, s,
+  lt_irrefl := lt_irrefl',
+  le_of_lt := le_of_lt',
+  lt_of_le_of_lt := lt_of_le_of_lt',
+  lt_of_lt_of_le := lt_of_lt_of_le' ⦄
+
+/- linear orders -/
+
+structure linear_order_pair [class] (A : Type) extends order_pair A, linear_weak_order A
+
+structure linear_strong_order_pair [class] (A : Type) extends strong_order_pair A,
+    linear_weak_order A
+
+attribute [instance]
+definition linear_strong_order_pair.to_linear_order_pair
+    [s : linear_strong_order_pair A] : linear_order_pair A :=
+⦃ linear_order_pair, s, strong_order_pair.to_order_pair ⦄
+
+section
+  variable [linear_strong_order_pair A]
+  variables (a b c : A)
+
+  theorem lt.trichotomy : a < b ∨ a = b ∨ b < a :=
+  or.elim (le.total a b)
+    (assume H : a ≤ b,
+      or.elim (iff.mp le_iff_lt_or_eq H) (assume H1, or.inl H1) (assume H1, or.inr (or.inl H1)))
+    (assume H : b ≤ a,
+      or.elim (iff.mp le_iff_lt_or_eq H)
+        (assume H1, or.inr (or.inr H1))
+        (assume H1, or.inr (or.inl (symm H1))))
+
+  theorem lt.by_cases {a b : A} {P : Prop}
+    (H1 : a < b → P) (H2 : a = b → P) (H3 : b < a → P) : P :=
+  or.elim (lt.trichotomy a b)
+    (assume H, H1 H)
+    (assume H, or.elim H (assume H', H2 H') (assume H', H3 H'))
+
+  definition lt_ge_by_cases {a b : A} {P : Prop} (H1 : a < b → P) (H2 : a ≥ b → P) : P :=
+  lt.by_cases H1 (λH, H2 (H ▸ le.refl a)) (λH, H2 (le_of_lt H))
+
+  theorem le_of_not_gt {a b : A} (H : ¬ a > b) : a ≤ b :=
+  lt.by_cases (assume H', absurd H' H) (assume H', H' ▸ (le.refl b)) (assume H', le_of_lt H')
+
+  theorem lt_of_not_ge {a b : A} (H : ¬ a ≥ b) : a < b :=
+  lt.by_cases
+    (assume H', absurd (le_of_lt H') H)
+    (assume H', absurd (H' ▸ le.refl b) H)
+    (assume H', H')
+
+  theorem lt_or_ge : a < b ∨ a ≥ b :=
+  lt.by_cases
+    (assume H1 : a < b, or.inl H1)
+    (assume H1 : a = b, or.inr (H1 ▸ le.refl a))
+    (assume H1 : a > b, or.inr (le_of_lt H1))
+
+  theorem le_or_gt : a ≤ b ∨ a > b :=
+  or.swap (lt_or_ge b a)
+
+  theorem lt_or_gt_of_ne {a b : A} (H : a ≠ b) : a < b ∨ a > b :=
+  lt.by_cases (assume H1, or.inl H1) (assume H1, absurd H1 H) (assume H1, or.inr H1)
+end
+
+open decidable
+
+structure decidable_linear_order [class] (A : Type) extends linear_strong_order_pair A :=
+(decidable_lt : decidable_rel lt)
+
+section
+  variable [s : decidable_linear_order A]
+  variables {a b c d : A}
+  include s
+  open decidable
+
+  attribute [instance]
+  definition decidable_lt : decidable (a < b) :=
+    @decidable_linear_order.decidable_lt _ _ _ _
+
+  attribute [instance]
+  definition decidable_le : decidable (a ≤ b) :=
+  by_cases
+    (assume H : a < b, tt (le_of_lt H))
+    (assume H : ¬ a < b,
+      have H1 : b ≤ a, from le_of_not_gt H,
+      by_cases
+        (assume H2 : b < a, ff (not_le_of_gt H2))
+        (assume H2 : ¬ b < a, tt (le_of_not_gt H2)))
+
+  attribute [instance]
+  definition has_decidable_eq : decidable (a = b) :=
+  by_cases
+    (assume H : a ≤ b,
+      by_cases
+        (assume H1 : b ≤ a, tt (le.antisymm H H1))
+        (assume H1 : ¬ b ≤ a, ff (assume H2 : a = b, H1 (H2 ▸ le.refl a))))
+    (assume H : ¬ a ≤ b,
+      (ff (assume H1 : a = b, H (H1 ▸ le.refl a))))
+
+  theorem eq_or_lt_of_not_lt {a b : A} (H : ¬ a < b) : a = b ∨ b < a :=
+    if Heq : a = b then or.inl Heq else or.inr (lt_of_not_ge (λ Hge, H (lt_of_le_of_ne Hge Heq)))
+
+  theorem eq_or_lt_of_le {a b : A} (H : a ≤ b) : a = b ∨ a < b :=
+  sorry
+  /-
+    begin
+      cases eq_or_lt_of_not_lt (not_lt_of_ge H),
+      exact or.inl a_1⁻¹,
+      exact or.inr a_1
+    end
+  -/
+
+  -- testing equality first may result in more definitional equalities
+  definition lt.cases {B : Type} (a b : A) (t_lt t_eq t_gt : B) : B :=
+  if a = b then t_eq else (if a < b then t_lt else t_gt)
+
+  theorem lt.cases_of_eq {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a = b) :
+    lt.cases a b t_lt t_eq t_gt = t_eq := if_pos H
+
+  theorem lt.cases_of_lt {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a < b) :
+    lt.cases a b t_lt t_eq t_gt = t_lt :=
+  trans (if_neg (ne_of_lt H)) (if_pos H)
+
+  theorem lt.cases_of_gt {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a > b) :
+    lt.cases a b t_lt t_eq t_gt = t_gt :=
+  trans (if_neg (ne.symm (ne_of_lt H))) (if_neg (lt.asymm H))
+
+  definition min (a b : A) : A := if a ≤ b then a else b
+  definition max (a b : A) : A := if a ≤ b then b else a
+
+  /- these show min and max form a lattice -/
+
+  theorem min_le_left (a b : A) : min a b ≤ a :=
+  sorry
+  /-
+  by_cases
+    (assume H : a ≤ b, by rewrite [↑min, if_pos H])
+    (assume H : ¬ a ≤ b, by rewrite [↑min, if_neg H]; apply le_of_lt (lt_of_not_ge H))
+  -/
+
+  theorem min_le_right (a b : A) : min a b ≤ b :=
+  sorry
+  /-
+  by_cases
+    (assume H : a ≤ b, by rewrite [↑min, if_pos H]; apply H)
+    (assume H : ¬ a ≤ b, by rewrite [↑min, if_neg H])
+  -/
+
+  theorem le_min {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) : c ≤ min a b :=
+  sorry
+  /-
+  by_cases
+    (assume H : a ≤ b, by rewrite [↑min, if_pos H]; apply H₁)
+    (assume H : ¬ a ≤ b, by rewrite [↑min, if_neg H]; apply H₂)
+  -/
+
+  theorem le_max_left (a b : A) : a ≤ max a b :=
+  sorry
+  /-
+  by_cases
+    (assume H : a ≤ b, by rewrite [↑max, if_pos H]; apply H)
+    (assume H : ¬ a ≤ b, by rewrite [↑max, if_neg H])
+  -/
+
+  theorem le_max_right (a b : A) : b ≤ max a b :=
+  sorry
+  /-
+  by_cases
+    (assume H : a ≤ b, by rewrite [↑max, if_pos H])
+    (assume H : ¬ a ≤ b, by rewrite [↑max, if_neg H]; apply le_of_lt (lt_of_not_ge H))
+  -/
+
+  theorem max_le {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) : max a b ≤ c :=
+  sorry
+  /-
+  by_cases
+    (assume H : a ≤ b, by rewrite [↑max, if_pos H]; apply H₂)
+    (assume H : ¬ a ≤ b, by rewrite [↑max, if_neg H]; apply H₁)
+  -/
+
+  theorem le_max_left_iff_true (a b : A) : a ≤ max a b ↔ true :=
+  iff_true_intro (le_max_left a b)
+
+  theorem le_max_right_iff_true (a b : A) : b ≤ max a b ↔ true :=
+  iff_true_intro (le_max_right a b)
+
+  /- these are also proved for lattices, but with inf and sup in place of min and max -/
+
+  theorem eq_min {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) (H₃ : ∀{d}, d ≤ a → d ≤ b → d ≤ c) :
+    c = min a b :=
+  le.antisymm (le_min H₁ H₂) (H₃ (min_le_left a b) (min_le_right a b))
+
+  theorem min.comm (a b : A) : min a b = min b a :=
+  eq_min (min_le_right a b) (min_le_left a b) (λ c H₁ H₂, le_min H₂ H₁)
+
+  theorem min.assoc (a b c : A) : min (min a b) c = min a (min b c) :=
+  sorry
+  /-
+  begin
+    apply eq_min,
+    { apply le.trans, apply min_le_left, apply min_le_left },
+    { apply le_min, apply le.trans, apply min_le_left, apply min_le_right, apply min_le_right },
+    { intros [d, H₁, H₂], apply le_min, apply le_min H₁, apply le.trans H₂, apply min_le_left,
+      apply le.trans H₂, apply min_le_right }
+  end
+  -/
+
+  theorem min.left_comm (a b c : A) : min a (min b c) = min b (min a c) :=
+  binary.left_comm (@min.comm A s) (@min.assoc A s) a b c
+
+  theorem min.right_comm (a b c : A) : min (min a b) c = min (min a c) b :=
+  binary.right_comm (@min.comm A s) (@min.assoc A s) a b c
+
+  theorem min_self (a : A) : min a a = a :=
+  sorry -- by apply eq.symm; apply eq_min (le.refl a) !le.refl; intros; assumption
+
+  theorem min_eq_left {a b : A} (H : a ≤ b) : min a b = a :=
+  sorry -- by apply eq.symm; apply eq_min !le.refl H; intros; assumption
+
+  theorem min_eq_right {a b : A} (H : b ≤ a) : min a b = b :=
+  eq.subst (min.comm b a) (min_eq_left H)
+
+  theorem eq_max {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) (H₃ : ∀{d}, a ≤ d → b ≤ d → c ≤ d) :
+    c = max a b :=
+  le.antisymm (H₃ (le_max_left a b) (le_max_right a b)) (max_le H₁ H₂)
+
+  theorem max.comm (a b : A) : max a b = max b a :=
+  eq_max (le_max_right a b) (le_max_left a b) (λ c H₁ H₂, max_le H₂ H₁)
+
+  theorem max.assoc (a b c : A) : max (max a b) c = max a (max b c) :=
+  sorry
+  /-
+  begin
+    apply eq_max,
+    { apply le.trans, apply le_max_left a b, apply le_max_left },
+    { apply max_le, apply le.trans, apply le_max_right a b, apply le_max_left, apply le_max_right },
+    { intros [d, H₁, H₂], apply max_le, apply max_le H₁, apply le.trans !le_max_left H₂,
+      apply le.trans !le_max_right H₂}
+  end
+  -/
+
+  theorem max.left_comm (a b c : A) : max a (max b c) = max b (max a c) :=
+  binary.left_comm (@max.comm A s) (@max.assoc A s) a b c
+
+  theorem max.right_comm (a b c : A) : max (max a b) c = max (max a c) b :=
+  binary.right_comm (@max.comm A s) (@max.assoc A s) a b c
+
+  theorem max_self (a : A) : max a a = a :=
+  sorry -- by apply eq.symm; apply eq_max (le.refl a) !le.refl; intros; assumption
+
+  theorem max_eq_left {a b : A} (H : b ≤ a) : max a b = a :=
+  sorry -- by apply eq.symm; apply eq_max !le.refl H; intros; assumption
+
+  theorem max_eq_right {a b : A} (H : a ≤ b) : max a b = b :=
+  eq.subst (max.comm b a) (max_eq_left H)
+
+  /- these rely on lt_of_lt -/
+
+  theorem min_eq_left_of_lt {a b : A} (H : a < b) : min a b = a :=
+  min_eq_left (le_of_lt H)
+
+  theorem min_eq_right_of_lt {a b : A} (H : b < a) : min a b = b :=
+  min_eq_right (le_of_lt H)
+
+  theorem max_eq_left_of_lt {a b : A} (H : b < a) : max a b = a :=
+  max_eq_left (le_of_lt H)
+
+  theorem max_eq_right_of_lt {a b : A} (H : a < b) : max a b = b :=
+  max_eq_right (le_of_lt H)
+
+  /- these use the fact that it is a linear ordering -/
+
+  theorem lt_min {a b c : A} (H₁ : a < b) (H₂ : a < c) : a < min b c :=
+  sorry
+  /-
+  or.elim !le_or_gt
+    (assume H : b ≤ c, by rewrite (min_eq_left H); apply H₁)
+    (assume H : b > c, by rewrite (min_eq_right_of_lt H); apply H₂)
+  -/
+
+  theorem max_lt {a b c : A} (H₁ : a < c) (H₂ : b < c) : max a b < c :=
+  sorry
+  /-
+  or.elim !le_or_gt
+    (assume H : a ≤ b, by rewrite (max_eq_right H); apply H₂)
+    (assume H : a > b, by rewrite (max_eq_left_of_lt H); apply H₁)
+  -/
+end
+
+/- order instances -/
+
+attribute [instance]
+definition weak_order_Prop : weak_order Prop :=
+⦃ weak_order,
+  le           := λx y, x → y,
+  le_refl      := λx, id,
+  le_trans     := λa b c H1 H2 x, H2 (H1 x),
+  le_antisymm  := λf g H1 H2, propext (and.intro H1 H2)
+⦄
+
+attribute [instance]
+definition weak_order_fun (A B : Type) [weak_order B] : weak_order (A → B) :=
+⦃ weak_order,
+  le := λx y, ∀b, x b ≤ y b,
+  le_refl := λf b, le.refl (f b),
+  le_trans := λf g h H1 H2 b, le.trans (H1 b) (H2 b),
+  le_antisymm := λf g H1 H2, funext (λb, le.antisymm (H1 b) (H2 b))
+⦄
+
+definition weak_order_dual {A : Type} (wo : weak_order A) : weak_order A :=
+⦃ weak_order,
+  le := λx y, y ≤ x,
+  le_refl := le.refl,
+  le_trans := sorry, -- take a b c `b ≤ a` `c ≤ b`, le.trans `c ≤ b` `b ≤ a`,
+  le_antisymm := sorry ⦄ -- take a b `b ≤ a` `a ≤ b`, le.antisymm `a ≤ b` `b ≤ a` ⦄
+
+lemma le_dual_eq_le {A : Type} (wo : weak_order A) (a b : A) :
+  @le _ (@weak_order.to_has_le _ (weak_order_dual wo)) a b =
+  @le _ (@weak_order.to_has_le _ wo) b a :=
+rfl
+
+-- what to do with the strict variants?

old_library/algebra/order_bigops.lean

@@ -0,0 +1,477 @@
+/-
+Copyright (c) 2016 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad
+
+Min and max over finite sets.
+
+To support constructive theories, we start with the class
+decidable_linear_ordered_cancel_comm_monoid, because:
+(1) We need a decidable linear order to have min and max
+(2) We need a default element for min and max over the empty set, and max empty = 0 is the
+    right choice for nat.
+(3) All our number classes are instances.
+We can define variants of Min and Max if needed.
+-/
+import .group_bigops .ordered_ring
+
+variables {A B : Type}
+
+section
+  variable [decidable_linear_order A]
+
+  definition max_comm_semigroup : comm_semigroup A :=
+  ⦃ comm_semigroup,
+    mul       := max,
+    mul_assoc := max.assoc,
+    mul_comm  := max.comm
+  ⦄
+
+  definition min_comm_semigroup : comm_semigroup A :=
+  ⦃ comm_semigroup,
+    mul       := min,
+    mul_assoc := min.assoc,
+    mul_comm  := min.comm
+  ⦄
+end
+
+/- finset versions -/
+
+namespace finset
+
+section deceq_A
+variable [decidable_eq A]
+
+section decidable_linear_ordered_cancel_comm_monoid_B
+  variable [decidable_linear_ordered_cancel_comm_monoid B]
+
+  section max_comm_semigroup
+    local attribute max_comm_semigroup [instance]
+    open Prod_semigroup
+
+    definition Max (s : finset A) (f : A → B) : B := Prod_semigroup 0 s f
+    notation `Max` binders `∈` s `, ` r:(scoped f, Max s f) := r
+
+    proposition Max_empty (f : A → B) : (Max x ∈ ∅, f x) = 0 := !Prod_semigroup_empty
+
+    proposition Max_singleton (f : A → B) (a : A) : (Max x ∈ '{a}, f x) = f a :=
+    !Prod_semigroup_singleton
+
+    proposition Max_insert_insert (f : A → B) {a₁ a₂ : A} {s : finset A} :
+        a₂ ∉ s → a₁ ∉ insert a₂ s →
+      (Max x ∈ insert a₁ (insert a₂ s), f x) = max (f a₁) (Max x ∈ insert a₂ s, f x) :=
+    !Prod_semigroup_insert_insert
+
+    proposition Max_insert (f : A → B) {a : A} {s : finset A} (anins : a ∉ s) (sne : s ≠ ∅) :
+      (Max x ∈ insert a s, f x) = max (f a) (Max x ∈ s, f x) :=
+    !Prod_semigroup_insert anins sne
+  end max_comm_semigroup
+
+  proposition Max_pair (f : A → B) (a₁ a₂ : A) : (Max x ∈ '{a₁, a₂}, f x) = max (f a₁) (f a₂) :=
+  decidable.by_cases
+    (suppose a₁ = a₂, by rewrite [this, pair_eq_singleton, max_self] )
+    (suppose a₁ ≠ a₂,
+      have a₁ ∉ '{a₂}, by rewrite [mem_singleton_iff]; apply this,
+      using this, by rewrite [Max_insert f this !singleton_ne_empty])
+
+  proposition le_Max (f : A → B) {a : A} {s : finset A} (H : a ∈ s) : f a ≤ Max x ∈ s, f x :=
+  begin
+    induction s with a' s' a'nins' ih,
+      {exact false.elim (not_mem_empty a H)},
+    cases (decidable.em (s' = ∅)) with s'empty s'nempty,
+      {rewrite [s'empty at *, Max_singleton, eq_of_mem_singleton H]},
+    rewrite [Max_insert f a'nins' s'nempty],
+    cases (eq_or_mem_of_mem_insert H) with aeqa' ains',
+      {rewrite aeqa', apply le_max_left},
+    apply le.trans (ih ains') !le_max_right
+  end
+
+  proposition Max_le (f : A → B) {s : finset A} {b : B} (sne : s ≠ ∅) (H : ∀ a, a ∈ s → f a ≤ b) :
+    (Max x ∈ s, f x) ≤ b :=
+  begin
+    induction s with a' s' a'nins' ih,
+      {exact absurd rfl sne},
+    cases (decidable.em (s' = ∅)) with s'empty s'nempty,
+      {rewrite [s'empty, Max_singleton], exact H a' !mem_insert},
+    rewrite [Max_insert f a'nins' s'nempty],
+    apply max_le (H a' !mem_insert),
+    apply ih s'nempty,
+    intro a H',
+    exact H a (mem_insert_of_mem a' H')
+  end
+
+  proposition Max_add_right (f : A → B) {s : finset A} (b : B) (sne : s ≠ ∅) :
+    (Max x ∈ s, f x + b) = (Max x ∈ s, f x) + b :=
+  begin
+    induction s with a' s' a'nins' ih,
+      {exact absurd rfl sne},
+    cases (decidable.em (s' = ∅)) with s'empty s'ne,
+      {rewrite [s'empty, Max_singleton]},
+    rewrite [*Max_insert _ a'nins' s'ne, ih s'ne, max_add_add_right]
+  end
+
+  proposition Max_add_left (f : A → B) {s : finset A} (b : B) (sne : s ≠ ∅) :
+    (Max x ∈ s, b + f x) = b + (Max x ∈ s, f x) :=
+  begin
+    induction s with a' s' a'nins' ih,
+      {exact absurd rfl sne},
+    cases (decidable.em (s' = ∅)) with s'empty s'ne,
+      {rewrite [s'empty, Max_singleton]},
+    rewrite [*Max_insert _ a'nins' s'ne, ih s'ne, max_add_add_left]
+  end
+
+  section min_comm_semigroup
+    local attribute min_comm_semigroup [instance]
+    open Prod_semigroup
+
+    definition Min (s : finset A) (f : A → B) : B := Prod_semigroup 0 s f
+    notation `Min` binders `∈` s `, ` r:(scoped f, Min s f) := r
+
+    proposition Min_empty (f : A → B) : (Min x ∈ ∅, f x) = 0 := !Prod_semigroup_empty
+
+    proposition Min_singleton (f : A → B) (a : A) : (Min x ∈ '{a}, f x) = f a :=
+    !Prod_semigroup_singleton
+
+    proposition Min_insert_insert (f : A → B) {a₁ a₂ : A} {s : finset A} :
+        a₂ ∉ s → a₁ ∉ insert a₂ s →
+      (Min x ∈ insert a₁ (insert a₂ s), f x) = min (f a₁) (Min x ∈ insert a₂ s, f x) :=
+    !Prod_semigroup_insert_insert
+
+    proposition Min_insert (f : A → B) {a : A} {s : finset A} (anins : a ∉ s) (sne : s ≠ ∅) :
+      (Min x ∈ insert a s, f x) = min (f a) (Min x ∈ s, f x) :=
+    !Prod_semigroup_insert anins sne
+  end min_comm_semigroup
+
+  proposition Min_pair (f : A → B) (a₁ a₂ : A) : (Min x ∈ '{a₁, a₂}, f x) = min (f a₁) (f a₂) :=
+  decidable.by_cases
+    (suppose a₁ = a₂, by rewrite [this, pair_eq_singleton, min_self] )
+    (suppose a₁ ≠ a₂,
+      have a₁ ∉ '{a₂}, by rewrite [mem_singleton_iff]; apply this,
+      using this, by rewrite [Min_insert f this !singleton_ne_empty])
+
+  proposition Min_le (f : A → B) {a : A} {s : finset A} (H : a ∈ s) : (Min x ∈ s, f x) ≤ f a :=
+  begin
+    induction s with a' s' a'nins' ih,
+      {exact false.elim (not_mem_empty a H)},
+    cases (decidable.em (s' = ∅)) with s'empty s'nempty,
+      {rewrite [s'empty at *, Min_singleton, eq_of_mem_singleton H]},
+    rewrite [Min_insert f a'nins' s'nempty],
+    cases (eq_or_mem_of_mem_insert H) with aeqa' ains',
+      {rewrite aeqa', apply min_le_left},
+    apply le.trans !min_le_right (ih ains')
+  end
+
+  proposition le_Min (f : A → B) {s : finset A} {b : B} (sne : s ≠ ∅) (H : ∀ a, a ∈ s → b ≤ f a) :
+    b ≤ Min x ∈ s, f x :=
+  begin
+    induction s with a' s' a'nins' ih,
+      {exact absurd rfl sne},
+    cases (decidable.em (s' = ∅)) with s'empty s'nempty,
+      {rewrite [s'empty, Min_singleton], exact H a' !mem_insert},
+    rewrite [Min_insert f a'nins' s'nempty],
+    apply le_min (H a' !mem_insert),
+    apply ih s'nempty,
+    intro a H',
+    exact H a (mem_insert_of_mem a' H')
+  end
+
+  proposition Min_add_right (f : A → B) {s : finset A} (b : B) (sne : s ≠ ∅) :
+    (Min x ∈ s, f x + b) = (Min x ∈ s, f x) + b :=
+  begin
+    induction s with a' s' a'nins' ih,
+      {exact absurd rfl sne},
+    cases (decidable.em (s' = ∅)) with s'empty s'ne,
+      {rewrite [s'empty, Min_singleton]},
+    rewrite [*Min_insert _ a'nins' s'ne, ih s'ne, min_add_add_right]
+  end
+
+  proposition Min_add_left (f : A → B) {s : finset A} (b : B) (sne : s ≠ ∅) :
+    (Min x ∈ s, b + f x) = b + (Min x ∈ s, f x) :=
+  begin
+    induction s with a' s' a'nins' ih,
+      {exact absurd rfl sne},
+    cases (decidable.em (s' = ∅)) with s'empty s'ne,
+      {rewrite [s'empty, Min_singleton]},
+    rewrite [*Min_insert _ a'nins' s'ne, ih s'ne, min_add_add_left]
+  end
+end decidable_linear_ordered_cancel_comm_monoid_B
+
+section decidable_linear_ordered_comm_group_B
+  variable [decidable_linear_ordered_comm_group B]
+
+  proposition Max_neg (f : A → B) (s : finset A) : (Max x ∈ s, - f x) = - Min x ∈ s, f x :=
+  begin
+    cases (decidable.em (s = ∅)) with se sne,
+      {rewrite [se, Max_empty, Min_empty, neg_zero]},
+    apply eq_of_le_of_ge,
+      {apply !Max_le sne,
+         intro a ains,
+         apply neg_le_neg,
+         apply !Min_le ains},
+    apply neg_le_of_neg_le,
+    apply !le_Min sne,
+    intro a ains,
+    apply neg_le_of_neg_le,
+    apply !le_Max ains
+  end
+
+  proposition Min_neg (f : A → B) (s : finset A) : (Min x ∈ s, - f x) = - Max x ∈ s, f x :=
+  begin
+    cases (decidable.em (s = ∅)) with se sne,
+      {rewrite [se, Max_empty, Min_empty, neg_zero]},
+    apply eq_of_le_of_ge,
+      {apply le_neg_of_le_neg,
+        apply !Max_le sne,
+        intro a ains,
+        apply le_neg_of_le_neg,
+        apply !Min_le ains},
+    apply !le_Min sne,
+    intro a ains,
+    apply neg_le_neg,
+    apply !le_Max ains
+  end
+
+  proposition Max_eq_neg_Min_neg (f : A → B) (s : finset A) :
+    (Max x ∈ s, f x) = - Min x ∈ s, - f x :=
+  by rewrite [Min_neg, neg_neg]
+
+  proposition Min_eq_neg_Max_neg (f : A → B) (s : finset A) :
+    (Min x ∈ s, f x) = - Max x ∈ s, - f x :=
+  by rewrite [Max_neg, neg_neg]
+
+end decidable_linear_ordered_comm_group_B
+
+end deceq_A
+
+/- Min and Max *of* a finset -/
+
+section decidable_linear_ordered_semiring_A
+  variable [decidable_linear_ordered_semiring A]
+
+  definition Max₀ (s : finset A) : A := Max x ∈ s, x
+  definition Min₀ (s : finset A) : A := Min x ∈ s, x
+
+  proposition Max₀_empty : Max₀ ∅ = (0 : A) := !Max_empty
+
+  proposition Max₀_singleton (a : A) : Max₀ '{a} = a := !Max_singleton
+
+  proposition Max₀_insert_insert {a₁ a₂ : A} {s : finset A} (H₁ : a₂ ∉ s) (H₂ : a₁ ∉ insert a₂ s) :
+    Max₀ (insert a₁ (insert a₂ s)) = max a₁ (Max₀ (insert a₂ s)) :=
+  !Max_insert_insert H₁ H₂
+
+  proposition Max₀_insert {s : finset A} {a : A} (anins : a ∉ s) (sne : s ≠ ∅) :
+    Max₀ (insert a s) = max a (Max₀ s) := !Max_insert anins sne
+
+  proposition Max₀_pair (a₁ a₂ : A) : Max₀ '{a₁, a₂} = max a₁ a₂ := !Max_pair
+
+  proposition le_Max₀ {a : A} {s : finset A} (H : a ∈ s) : a ≤ Max₀ s := !le_Max H
+
+  proposition Max₀_le {s : finset A} {a : A} (sne : s ≠ ∅) (H : ∀ x, x ∈ s → x ≤ a) :
+    Max₀ s ≤ a := !Max_le sne H
+
+  proposition Min₀_empty : Min₀ ∅ = (0 : A) := !Min_empty
+
+  proposition Min₀_singleton (a : A) : Min₀ '{a} = a := !Min_singleton
+
+  proposition Min₀_insert_insert {a₁ a₂ : A} {s : finset A} (H₁ : a₂ ∉ s) (H₂ : a₁ ∉ insert a₂ s) :
+    Min₀ (insert a₁ (insert a₂ s)) = min a₁ (Min₀ (insert a₂ s)) :=
+  !Min_insert_insert H₁ H₂
+
+  proposition Min₀_insert {s : finset A} {a : A} (anins : a ∉ s) (sne : s ≠ ∅) :
+    Min₀ (insert a s) = min a (Min₀ s) := !Min_insert anins sne
+
+  proposition Min₀_pair (a₁ a₂ : A) : Min₀ '{a₁, a₂} = min a₁ a₂ := !Min_pair
+
+  proposition Min₀_le {a : A} {s : finset A} (H : a ∈ s) : Min₀ s ≤ a := !Min_le H
+
+  proposition le_Min₀ {s : finset A} {a : A} (sne : s ≠ ∅) (H : ∀ x, x ∈ s → a ≤ x) :
+    a ≤ Min₀ s := !le_Min sne H
+end decidable_linear_ordered_semiring_A
+
+end finset
+
+/- finite set versions -/
+
+namespace set
+local attribute classical.prop_decidable [instance]
+
+section decidable_linear_ordered_cancel_comm_monoid_B
+  variable [decidable_linear_ordered_cancel_comm_monoid B]
+
+  noncomputable definition Max (s : set A) (f : A → B) : B := finset.Max (to_finset s) f
+  notation `Max` binders `∈` s `, ` r:(scoped f, Max s f) := r
+
+  noncomputable definition Min (s : set A) (f : A → B) : B := finset.Min (to_finset s) f
+  notation `Min` binders `∈` s `, ` r:(scoped f, Min s f) := r
+
+  proposition Max_empty (f : A → B) : (Max x ∈ ∅, f x) = 0 :=
+  by rewrite [↑set.Max, to_finset_empty, finset.Max_empty]
+
+  proposition Max_singleton (f : A → B) (a : A) : (Max x ∈ '{a}, f x) = f a :=
+  by rewrite [↑set.Max, to_finset_insert, to_finset_empty, finset.Max_singleton]
+
+  proposition Max_insert_insert (f : A → B) {a₁ a₂ : A} {s : set A} [h : finite s] :
+      a₂ ∉ s → a₁ ∉ insert a₂ s →
+    (Max x ∈ insert a₁ (insert a₂ s), f x) = max (f a₁) (Max x ∈ insert a₂ s, f x) :=
+  begin
+    rewrite [↑set.Max, -+mem_to_finset_eq, +to_finset_insert],
+    apply finset.Max_insert_insert
+  end
+
+  proposition Max_insert (f : A → B) {a : A} {s : set A} [h : finite s] (anins : a ∉ s)
+      (sne : s ≠ ∅) :
+    (Max x ∈ insert a s, f x) = max (f a) (Max x ∈ s, f x) :=
+  begin
+    revert anins sne,
+    rewrite [↑set.Max, -+mem_to_finset_eq, +to_finset_insert],
+    intro h1 h2,
+    apply finset.Max_insert f h1 (λ h', h2 (eq_empty_of_to_finset_eq_empty h')),
+  end
+
+  proposition Max_pair (f : A → B) (a₁ a₂ : A) : (Max x ∈ '{a₁, a₂}, f x) = max (f a₁) (f a₂) :=
+  by rewrite [↑set.Max, +to_finset_insert, +to_finset_empty, finset.Max_pair]
+
+  proposition le_Max (f : A → B) {a : A} {s : set A} [fins : finite s] (H : a ∈ s) :
+    f a ≤ Max x ∈ s, f x :=
+  by rewrite [-+mem_to_finset_eq at H, ↑set.Max]; exact finset.le_Max f H
+
+  proposition Max_le (f : A → B) {s : set A} [fins : finite s] {b : B} (sne : s ≠ ∅)
+      (H : ∀ a, a ∈ s → f a ≤ b) :
+    (Max x ∈ s, f x) ≤ b :=
+  begin
+    rewrite [↑set.Max],
+    apply finset.Max_le f (λ H', sne (eq_empty_of_to_finset_eq_empty H')),
+    intro a H', apply H a, rewrite mem_to_finset_eq at H', exact H'
+  end
+
+  proposition Max_add_right (f : A → B) {s : set A} [fins : finite s] (b : B) (sne : s ≠ ∅) :
+    (Max x ∈ s, f x + b) = (Max x ∈ s, f x) + b :=
+  begin
+    rewrite [↑set.Max],
+    apply finset.Max_add_right f b (λ h, sne (eq_empty_of_to_finset_eq_empty h))
+  end
+
+  proposition Max_add_left (f : A → B) {s : set A} [fins : finite s] (b : B) (sne : s ≠ ∅) :
+    (Max x ∈ s, b + f x) = b + (Max x ∈ s, f x) :=
+  begin
+    rewrite [↑set.Max],
+    apply finset.Max_add_left f b (λ h, sne (eq_empty_of_to_finset_eq_empty h))
+  end
+
+  proposition Min_empty (f : A → B) : (Min x ∈ ∅, f x) = 0 :=
+  by rewrite [↑set.Min, to_finset_empty, finset.Min_empty]
+
+  proposition Min_singleton (f : A → B) (a : A) : (Min x ∈ '{a}, f x) = f a :=
+  by rewrite [↑set.Min, to_finset_insert, to_finset_empty, finset.Min_singleton]
+
+  proposition Min_insert_insert (f : A → B) {a₁ a₂ : A} {s : set A} [h : finite s] :
+      a₂ ∉ s → a₁ ∉ insert a₂ s →
+    (Min x ∈ insert a₁ (insert a₂ s), f x) = min (f a₁) (Min x ∈ insert a₂ s, f x) :=
+  begin
+    rewrite [↑set.Min, -+mem_to_finset_eq, +to_finset_insert],
+    apply finset.Min_insert_insert
+  end
+
+  proposition Min_insert (f : A → B) {a : A} {s : set A} [h : finite s] (anins : a ∉ s)
+      (sne : s ≠ ∅) :
+    (Min x ∈ insert a s, f x) = min (f a) (Min x ∈ s, f x) :=
+  begin
+    revert anins sne,
+    rewrite [↑set.Min, -+mem_to_finset_eq, +to_finset_insert],
+    intro h1 h2,
+    apply finset.Min_insert f h1 (λ h', h2 (eq_empty_of_to_finset_eq_empty h')),
+  end
+
+  proposition Min_pair (f : A → B) (a₁ a₂ : A) : (Min x ∈ '{a₁, a₂}, f x) = min (f a₁) (f a₂) :=
+  by rewrite [↑set.Min, +to_finset_insert, +to_finset_empty, finset.Min_pair]
+
+  proposition Min_le (f : A → B) {a : A} {s : set A} [fins : finite s] (H : a ∈ s) :
+    (Min x ∈ s, f x) ≤ f a :=
+  by rewrite [-+mem_to_finset_eq at H, ↑set.Min]; exact finset.Min_le f H
+
+  proposition le_Min (f : A → B) {s : set A} [fins : finite s] {b : B} (sne : s ≠ ∅)
+      (H : ∀ a, a ∈ s → b ≤ f a) :
+    b ≤ Min x ∈ s, f x :=
+  begin
+    rewrite [↑set.Min],
+    apply finset.le_Min f (λ H', sne (eq_empty_of_to_finset_eq_empty H')),
+    intro a H', apply H a, rewrite mem_to_finset_eq at H', exact H'
+  end
+
+  proposition Min_add_right (f : A → B) {s : set A} [fins : finite s] (b : B) (sne : s ≠ ∅) :
+    (Min x ∈ s, f x + b) = (Min x ∈ s, f x) + b :=
+  begin
+    rewrite [↑set.Min],
+    apply finset.Min_add_right f b (λ h, sne (eq_empty_of_to_finset_eq_empty h))
+  end
+
+  proposition Min_add_left (f : A → B) {s : set A} [fins : finite s] (b : B) (sne : s ≠ ∅) :
+    (Min x ∈ s, b + f x) = b + (Min x ∈ s, f x) :=
+  begin
+    rewrite [↑set.Min],
+    apply finset.Min_add_left f b (λ h, sne (eq_empty_of_to_finset_eq_empty h))
+  end
+end decidable_linear_ordered_cancel_comm_monoid_B
+
+section decidable_linear_ordered_comm_group_B
+  variable [decidable_linear_ordered_comm_group B]
+
+  proposition Max_neg (f : A → B) (s : set A) : (Max x ∈ s, - f x) = - Min x ∈ s, f x :=
+  by rewrite [↑set.Max, finset.Max_neg]
+
+  proposition Min_neg (f : A → B) (s : set A) : (Min x ∈ s, - f x) = - Max x ∈ s, f x :=
+  by rewrite [↑set.Min, finset.Min_neg]
+
+  proposition Max_eq_neg_Min_neg (f : A → B) (s : set A) : (Max x ∈ s, f x) = - Min x ∈ s, - f x :=
+  by rewrite [↑set.Max, ↑set.Min, finset.Max_eq_neg_Min_neg]
+
+  proposition Min_eq_neg_Max_neg (f : A → B) (s : set A) : (Min x ∈ s, f x) = - Max x ∈ s, - f x :=
+  by rewrite [↑set.Max, ↑set.Min, finset.Min_eq_neg_Max_neg]
+end decidable_linear_ordered_comm_group_B
+
+section decidable_linear_ordered_semiring_A
+  variable [decidable_linear_ordered_semiring A]
+
+  noncomputable definition Max₀ (s : set A) : A := Max x ∈ s, x
+  noncomputable definition Min₀ (s : set A) : A := Min x ∈ s, x
+
+  proposition Max₀_empty : Max₀ ∅ = (0 : A) := !Max_empty
+
+  proposition Max₀_singleton (a : A) : Max₀ '{a} = a := !Max_singleton
+
+  proposition Max₀_insert_insert {a₁ a₂ : A} {s : set A} [fins : finite s] (H₁ : a₂ ∉ s)
+      (H₂ : a₁ ∉ insert a₂ s) :
+    Max₀ (insert a₁ (insert a₂ s)) = max a₁ (Max₀ (insert a₂ s)) :=
+  !Max_insert_insert H₁ H₂
+
+  proposition Max₀_insert {s : set A} [fins : finite s] {a : A} (anins : a ∉ s) (sne : s ≠ ∅) :
+    Max₀ (insert a s) = max a (Max₀ s) := !Max_insert anins sne
+
+  proposition Max₀_pair (a₁ a₂ : A) : Max₀ '{a₁, a₂} = max a₁ a₂ := !Max_pair
+
+  proposition le_Max₀ {a : A} {s : set A} [fins : finite s] (H : a ∈ s) : a ≤ Max₀ s := !le_Max H
+
+  proposition Max₀_le {s : set A} [fins : finite s] {a : A} (sne : s ≠ ∅) (H : ∀ x, x ∈ s → x ≤ a) :
+    Max₀ s ≤ a := !Max_le sne H
+
+  proposition Min₀_empty : Min₀ ∅ = (0 : A) := !Min_empty
+
+  proposition Min₀_singleton (a : A) : Min₀ '{a} = a := !Min_singleton
+
+  proposition Min₀_insert_insert {a₁ a₂ : A} {s : set A} [fins : finite s] (H₁ : a₂ ∉ s)
+      (H₂ : a₁ ∉ insert a₂ s) :
+    Min₀ (insert a₁ (insert a₂ s)) = min a₁ (Min₀ (insert a₂ s)) :=
+  !Min_insert_insert H₁ H₂
+
+  proposition Min₀_insert {s : set A} [fins : finite s] {a : A} (anins : a ∉ s) (sne : s ≠ ∅) :
+    Min₀ (insert a s) = min a (Min₀ s) := !Min_insert anins sne
+
+  proposition Min₀_pair (a₁ a₂ : A) : Min₀ '{a₁, a₂} = min a₁ a₂ := !Min_pair
+
+  proposition Min₀_le {a : A} {s : set A} [fins : finite s] (H : a ∈ s) : Min₀ s ≤ a := !Min_le H
+
+  proposition le_Min₀ {s : set A} [fins : finite s] {a : A} (sne : s ≠ ∅) (H : ∀ x, x ∈ s → a ≤ x) :
+    a ≤ Min₀ s := !le_Min sne H
+end decidable_linear_ordered_semiring_A
+
+end set

old_library/algebra/ordered_field.lean

@@ -0,0 +1,672 @@
+/-
+Copyright (c) 2014 Robert Lewis. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Robert Lewis
+-/
+import algebra.ordered_ring algebra.field
+open eq
+
+structure linear_ordered_field [class] (A : Type) extends linear_ordered_ring A, field A
+
+section linear_ordered_field
+
+  variable {A : Type}
+  variables [s : linear_ordered_field A] {a b c d : A}
+  include s
+
+  -- helpers for following
+  theorem mul_zero_lt_mul_inv_of_pos (H : 0 < a) : a * 0 < a * (1 / a) :=
+  sorry
+  /-
+   calc
+      a * 0 = 0           : by rewrite mul_zero
+        ... < 1           : !zero_lt_one
+        ... = a * a⁻¹     : eq.symm (mul_inv_cancel (ne.symm (ne_of_lt H)))
+        ... = a * (1 / a) : by rewrite inv_eq_one_div
+  -/
+  theorem mul_zero_lt_mul_inv_of_neg (H : a < 0) : a * 0 < a * (1 / a) :=
+  sorry
+  /-
+    calc
+      a * 0 = 0           : by rewrite mul_zero
+        ... < 1           : !zero_lt_one
+        ... = a * a⁻¹     : eq.symm (mul_inv_cancel (ne_of_lt H))
+        ... = a * (1 / a) : by rewrite inv_eq_one_div
+  -/
+
+  theorem one_div_pos_of_pos (H : 0 < a) : 0 < 1 / a :=
+    lt_of_mul_lt_mul_left (mul_zero_lt_mul_inv_of_pos H) (le_of_lt H)
+
+  theorem one_div_neg_of_neg (H : a < 0) : 1 / a < 0 :=
+    gt_of_mul_lt_mul_neg_left (mul_zero_lt_mul_inv_of_neg H) (le_of_lt H)
+
+
+  theorem le_mul_of_ge_one_right (Hb : b ≥ 0) (H : a ≥ 1) : b ≤ b * a :=
+      mul_one _ ▸ (mul_le_mul_of_nonneg_left H Hb)
+
+  theorem lt_mul_of_gt_one_right (Hb : b > 0) (H : a > 1) : b < b * a :=
+      mul_one _ ▸ (mul_lt_mul_of_pos_left H Hb)
+
+  theorem one_le_div_iff_le (a : A) {b : A} (Hb : b > 0) : 1 ≤ a / b ↔ b ≤ a :=
+    have Hb' : b ≠ 0, from ne.symm (ne_of_lt Hb),
+    iff.intro
+    (assume H : 1 ≤ a / b,
+      calc
+        b   = b           : rfl
+        ... ≤ b * (a / b) : le_mul_of_ge_one_right (le_of_lt Hb) H
+        ... = a           : mul_div_cancel' Hb')
+    (assume H : b ≤ a,
+      have Hbinv : 1 / b > 0, from  one_div_pos_of_pos Hb, calc
+        1  = b * (1 / b) : eq.symm (mul_one_div_cancel Hb')
+       ... ≤ a * (1 / b) : mul_le_mul_of_nonneg_right H (le_of_lt Hbinv)
+       ... = a / b       : eq.symm $ div_eq_mul_one_div a b)
+
+  theorem le_of_one_le_div (Hb : b > 0) (H : 1 ≤ a / b) : b ≤ a :=
+  iff.mp (one_le_div_iff_le a Hb) H
+
+  theorem one_le_div_of_le (Hb : b > 0) (H : b ≤ a) : 1 ≤ a / b :=
+  iff.mpr (one_le_div_iff_le a Hb) H
+
+  theorem one_lt_div_iff_lt (a : A) {b : A} (Hb : b > 0) : 1 < a / b ↔ b < a :=
+  have Hb' : b ≠ 0, from ne.symm (ne_of_lt Hb),
+  iff.intro
+    (assume H : 1 < a / b,
+      calc
+        b   < b * (a / b) : lt_mul_of_gt_one_right Hb H
+        ... = a           : mul_div_cancel' Hb')
+    (assume H : b < a,
+      have Hbinv : 1 / b > 0, from  one_div_pos_of_pos Hb, calc
+        1 = b * (1 / b) : eq.symm (mul_one_div_cancel Hb')
+      ... < a * (1 / b) : mul_lt_mul_of_pos_right H Hbinv
+      ... = a / b       : eq.symm $ div_eq_mul_one_div a b)
+
+  theorem lt_of_one_lt_div (Hb : b > 0) (H : 1 < a / b) : b < a :=
+  iff.mp (one_lt_div_iff_lt a Hb) H
+
+  theorem one_lt_div_of_lt (Hb : b > 0) (H : b < a) : 1 < a / b :=
+  iff.mpr (one_lt_div_iff_lt a Hb) H
+
+  theorem exists_lt (a : A) : ∃ x, x < a :=
+  have H : a - 1 < a, from add_lt_of_le_of_neg (le.refl _) zero_gt_neg_one,
+  exists.intro _ H
+
+  theorem exists_gt (a : A) : ∃ x, x > a :=
+  have H : a + 1 > a, from lt_add_of_le_of_pos (le.refl _) zero_lt_one,
+  exists.intro _ H
+
+  -- the following theorems amount to four iffs, for <, ≤, ≥, >.
+
+  theorem mul_le_of_le_div (Hc : 0 < c) (H : a ≤ b / c) : a * c ≤ b :=
+  div_mul_cancel b (ne.symm (ne_of_lt Hc)) ▸ mul_le_mul_of_nonneg_right H (le_of_lt Hc)
+
+  theorem le_div_of_mul_le (Hc : 0 < c) (H : a * c ≤ b) : a ≤ b / c :=
+  calc
+      a   = a * c * (1 / c) : mul_mul_div a (ne.symm (ne_of_lt Hc))
+      ... ≤ b * (1 / c)     : mul_le_mul_of_nonneg_right H (le_of_lt (one_div_pos_of_pos Hc))
+      ... = b / c           : eq.symm $ div_eq_mul_one_div b c
+
+  theorem mul_lt_of_lt_div (Hc : 0 < c) (H : a < b / c) : a * c < b :=
+  div_mul_cancel b (ne.symm (ne_of_lt Hc)) ▸ mul_lt_mul_of_pos_right H Hc
+
+  theorem lt_div_of_mul_lt (Hc : 0 < c) (H : a * c < b) : a < b / c :=
+  calc
+      a   = a * c * (1 / c) : mul_mul_div a (ne.symm (ne_of_lt Hc))
+      ... < b * (1 / c)     : mul_lt_mul_of_pos_right H (one_div_pos_of_pos Hc)
+      ... = b / c           : eq.symm $ div_eq_mul_one_div b c
+
+  theorem mul_le_of_div_le_of_neg (Hc : c < 0) (H : b / c ≤ a) : a * c ≤ b :=
+  div_mul_cancel b (ne_of_lt Hc) ▸ mul_le_mul_of_nonpos_right H (le_of_lt Hc)
+
+  theorem div_le_of_mul_le_of_neg (Hc : c < 0) (H : a * c ≤ b) : b / c ≤ a :=
+  calc
+      a   = a * c * (1 / c) : mul_mul_div a (ne_of_lt Hc)
+      ... ≥ b * (1 / c)     : mul_le_mul_of_nonpos_right H (le_of_lt (one_div_neg_of_neg Hc))
+      ... = b / c           : eq.symm $ div_eq_mul_one_div b c
+
+  theorem mul_lt_of_gt_div_of_neg (Hc : c < 0) (H : a > b / c) : a * c < b :=
+  div_mul_cancel b (ne_of_lt Hc) ▸ mul_lt_mul_of_neg_right H Hc
+
+  theorem div_lt_of_mul_lt_of_pos (Hc : c > 0) (H : b < a * c) : b / c < a :=
+  calc
+      a   = a * c * (1 / c) : mul_mul_div a (ne_of_gt Hc)
+      ... > b * (1 / c)     : mul_lt_mul_of_pos_right H (one_div_pos_of_pos Hc)
+      ... = b / c           : eq.symm $ div_eq_mul_one_div b c
+
+  theorem div_lt_of_mul_gt_of_neg (Hc : c < 0) (H : a * c < b) : b / c < a :=
+    calc
+      a   = a * c * (1 / c) : mul_mul_div a (ne_of_lt Hc)
+      ... > b * (1 / c)     : mul_lt_mul_of_neg_right H (one_div_neg_of_neg Hc)
+      ... = b / c           : eq.symm $ div_eq_mul_one_div b c
+
+  theorem div_le_of_le_mul (Hb : b > 0) (H : a ≤ b * c) : a / b ≤ c :=
+    calc
+      a / b = a * (1 / b)       : div_eq_mul_one_div a b
+        ... ≤ (b * c) * (1 / b) : mul_le_mul_of_nonneg_right H (le_of_lt (one_div_pos_of_pos Hb))
+        ... = (b * c) / b       : eq.symm $ div_eq_mul_one_div (b * c) b
+        ... = c                 : mul_div_cancel_left (ne.symm (ne_of_lt Hb))
+
+  theorem le_mul_of_div_le (Hc : c > 0) (H : a / c ≤ b) : a ≤ b * c :=
+  sorry
+  /-
+    calc
+      a = a / c * c : by rewrite (!div_mul_cancel (ne.symm (ne_of_lt Hc)))
+    ... ≤ b * c     : mul_le_mul_of_nonneg_right H (le_of_lt Hc)
+  -/
+
+  -- following these in the isabelle file, there are 8 biconditionals for the above with - signs
+  -- skipping for now
+
+  theorem mul_sub_mul_div_mul_neg (Hc : c ≠ 0) (Hd : d ≠ 0) (H : a / c < b / d) :
+      (a * d - b * c) / (c * d) < 0 :=
+  sorry
+  /-
+    have H1 : a / c - b / d < 0, from calc
+      a / c - b / d < b / d - b / d : sub_lt_sub_right H _
+      ... = 0                       : !sub_self,
+    calc
+      0 > a / c - b / d : H1
+      ... = (a * d - c * b) / (c * d) : !div_sub_div Hc Hd
+      ... = (a * d - b * c) / (c * d) : by rewrite (mul.comm b c)
+  -/
+  theorem mul_sub_mul_div_mul_nonpos (Hc : c ≠ 0) (Hd : d ≠ 0) (H : a / c ≤ b / d) :
+      (a * d - b * c) / (c * d) ≤ 0 :=
+  sorry
+  /-
+    have H1 : a / c - b / d ≤ 0, from calc
+      a / c - b / d ≤ b / d - b / d : sub_le_sub_right H _
+                ... = 0             : !sub_self,
+    calc
+      0 ≥ a / c - b / d : H1
+      ... = (a * d - c * b) / (c * d) : !div_sub_div Hc Hd
+      ... = (a * d - b * c) / (c * d) : by rewrite (mul.comm b c)
+  -/
+
+  theorem div_lt_div_of_mul_sub_mul_div_neg (Hc : c ≠ 0) (Hd : d ≠ 0)
+      (H : (a * d - b * c) / (c * d) < 0) : a / c < b / d :=
+  sorry
+  /-
+    have H1 : (a * d - c * b) / (c * d) < 0,     by rewrite [mul.comm c b]; exact H,
+    have H2 : a / c - b / d < 0,                 by rewrite [!div_sub_div Hc Hd]; exact H1,
+    have H3 : a / c - b / d + b / d < 0 + b / d, from add_lt_add_right H2 _,
+    begin rewrite [zero_add at H3, sub_eq_add_neg at H3, neg_add_cancel_right at H3], exact H3 end
+  -/
+
+  theorem div_le_div_of_mul_sub_mul_div_nonpos (Hc : c ≠ 0) (Hd : d ≠ 0)
+      (H : (a * d - b * c) / (c * d) ≤ 0) : a / c ≤ b / d :=
+  sorry
+  /-
+    have H1 : (a * d - c * b) / (c * d) ≤ 0,     by rewrite [mul.comm c b]; exact H,
+    have H2 : a / c - b / d ≤ 0,                 by rewrite [!div_sub_div Hc Hd]; exact H1,
+    have H3 : a / c - b / d + b / d ≤ 0 + b / d, from add_le_add_right H2 _,
+    begin rewrite [zero_add at H3, sub_eq_add_neg at H3, neg_add_cancel_right at H3], exact H3 end
+  -/
+
+  theorem div_pos_of_pos_of_pos (Ha : 0 < a) (Hb : 0 < b) : 0 < a / b :=
+  sorry
+  /-
+    begin
+      rewrite div_eq_mul_one_div,
+      apply mul_pos,
+      exact Ha,
+      apply one_div_pos_of_pos,
+      exact Hb
+    end
+  -/
+
+  theorem div_nonneg_of_nonneg_of_pos (Ha : 0 ≤ a) (Hb : 0 < b) : 0 ≤ a / b :=
+  sorry
+  /-
+    begin
+      rewrite div_eq_mul_one_div,
+      apply mul_nonneg,
+      exact Ha,
+      apply le_of_lt,
+      apply one_div_pos_of_pos,
+      exact Hb
+    end
+  -/
+
+  theorem div_neg_of_neg_of_pos (Ha : a < 0) (Hb : 0 < b) : a / b < 0:=
+  sorry
+  /-
+    begin
+      rewrite div_eq_mul_one_div,
+      apply mul_neg_of_neg_of_pos,
+      exact Ha,
+      apply one_div_pos_of_pos,
+      exact Hb
+    end
+  -/
+
+  theorem div_nonpos_of_nonpos_of_pos (Ha : a ≤ 0) (Hb : 0 < b) : a / b ≤ 0 :=
+  sorry
+  /-
+    begin
+      rewrite div_eq_mul_one_div,
+      apply mul_nonpos_of_nonpos_of_nonneg,
+      exact Ha,
+      apply le_of_lt,
+      apply one_div_pos_of_pos,
+      exact Hb
+    end
+  -/
+
+  theorem div_neg_of_pos_of_neg (Ha : 0 < a) (Hb : b < 0) : a / b < 0 :=
+  sorry
+  /-
+    begin
+      rewrite div_eq_mul_one_div,
+      apply mul_neg_of_pos_of_neg,
+      exact Ha,
+      apply one_div_neg_of_neg,
+      exact Hb
+    end
+  -/
+
+  theorem div_nonpos_of_nonneg_of_neg (Ha : 0 ≤ a) (Hb : b < 0) :  a / b ≤ 0 :=
+  sorry
+  /-
+    begin
+      rewrite div_eq_mul_one_div,
+      apply mul_nonpos_of_nonneg_of_nonpos,
+      exact Ha,
+      apply le_of_lt,
+      apply one_div_neg_of_neg,
+      exact Hb
+    end
+  -/
+
+  theorem div_pos_of_neg_of_neg (Ha : a < 0) (Hb : b < 0) : 0 < a / b :=
+  sorry
+  /-
+    begin
+      rewrite div_eq_mul_one_div,
+      apply mul_pos_of_neg_of_neg,
+      exact Ha,
+      apply one_div_neg_of_neg,
+      exact Hb
+    end
+  -/
+
+  theorem div_nonneg_of_nonpos_of_neg (Ha : a ≤ 0) (Hb : b < 0) : 0 ≤ a / b :=
+  sorry
+  /-
+    begin
+      rewrite div_eq_mul_one_div,
+      apply mul_nonneg_of_nonpos_of_nonpos,
+      exact Ha,
+      apply le_of_lt,
+      apply one_div_neg_of_neg,
+      exact Hb
+    end
+  -/
+
+  theorem div_lt_div_of_lt_of_pos (H : a < b) (Hc : 0 < c) : a / c < b / c :=
+  sorry
+  /-
+  begin
+    rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div],
+    exact mul_lt_mul_of_pos_right H (one_div_pos_of_pos Hc)
+  end
+  -/
+
+  theorem div_le_div_of_le_of_pos (H : a ≤ b) (Hc : 0 < c) : a / c ≤ b / c :=
+  sorry
+  /-
+    begin
+      rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div],
+      exact mul_le_mul_of_nonneg_right H (le_of_lt (one_div_pos_of_pos Hc))
+    end
+  -/
+
+  theorem div_lt_div_of_lt_of_neg (H : b < a) (Hc : c < 0) : a / c < b / c :=
+  sorry
+  /-
+  begin
+    rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div],
+    exact mul_lt_mul_of_neg_right H (one_div_neg_of_neg Hc)
+  end
+  -/
+
+  theorem div_le_div_of_le_of_neg (H : b ≤ a) (Hc : c < 0) : a / c ≤ b / c :=
+  sorry
+  /-
+  begin
+    rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div],
+    exact mul_le_mul_of_nonpos_right H (le_of_lt (one_div_neg_of_neg Hc))
+  end
+  -/
+
+  theorem two_pos : (1 : A) + 1 > 0 :=
+    add_pos zero_lt_one zero_lt_one
+
+  theorem one_add_one_ne_zero : 1 + 1 ≠ (0:A) :=
+  ne.symm (ne_of_lt two_pos)
+
+  theorem two_ne_zero : 2 ≠ (0:A) :=
+  sorry -- by unfold bit0; apply one_add_one_ne_zero
+
+  theorem add_halves (a : A) : a / 2 + a / 2 = a :=
+  sorry
+  /-
+    calc
+      a / 2 + a / 2 = (a + a) / 2 : by rewrite div_add_div_same
+      ... = (a * 1 + a * 1) / 2   : by rewrite mul_one
+      ... = (a * (1 + 1)) / 2     : by rewrite left_distrib
+      ... = (a * 2) / 2           : by rewrite one_add_one_eq_two
+      ... = a                     : by rewrite [@mul_div_cancel A _ _ _ two_ne_zero]
+  -/
+
+  theorem sub_self_div_two (a : A) : a - a / 2 = a / 2 :=
+  sorry -- by rewrite [-{a}add_halves at {1}, add_sub_cancel]
+
+  theorem add_midpoint {a b : A} (H : a < b) : a + (b - a) / 2 < b :=
+  sorry
+  /-
+  begin
+    rewrite [-div_sub_div_same, sub_eq_add_neg, {b / 2 + _}add.comm, -add.assoc, -sub_eq_add_neg],
+    apply add_lt_of_lt_sub_right,
+    rewrite *sub_self_div_two,
+    apply div_lt_div_of_lt_of_pos H two_pos
+  end
+  -/
+
+  theorem div_two_sub_self (a : A) : a / 2 - a = - (a / 2) :=
+  sorry -- by rewrite [-{a}add_halves at {2}, sub_add_eq_sub_sub, sub_self, zero_sub]
+
+  theorem add_self_div_two (a : A) : (a + a) / 2 = a :=
+  sorry
+  /-
+  symm (iff.mpr (!eq_div_iff_mul_eq (ne_of_gt (add_pos zero_lt_one zero_lt_one)))
+       (by krewrite [left_distrib, *mul_one]))
+  -/
+
+  theorem two_gt_one : (2:A) > 1 :=
+  calc (2:A) = 1+1 : one_add_one_eq_two
+       ...   > 1+0 : add_lt_add_left zero_lt_one _
+       ...   = 1   : add_zero 1
+
+  theorem two_ge_one : (2:A) ≥ 1 :=
+  le_of_lt two_gt_one
+
+  theorem four_pos : (4 : A) > 0 := add_pos two_pos two_pos
+
+  theorem mul_le_mul_of_mul_div_le (H : a * (b / c) ≤ d) (Hc : c > 0) : b * a ≤ d * c :=
+  sorry
+  /-
+  begin
+    rewrite [-mul_div_assoc at H, mul.comm b],
+    apply le_mul_of_div_le Hc H
+  end
+  -/
+
+  theorem div_two_lt_of_pos (H : a > 0) : a / (1 + 1) < a :=
+  have Ha : a / (1 + 1) > 0, from div_pos_of_pos_of_pos H (add_pos zero_lt_one zero_lt_one),
+  calc
+      a / (1 + 1) < a / (1 + 1) + a / (1 + 1) : lt_add_of_pos_left Ha
+              ... = a                         : add_halves a
+
+  theorem div_mul_le_div_mul_of_div_le_div_pos {e : A} (Hb : b ≠ 0) (Hd : d ≠ 0) (H : a / b ≤ c / d)
+          (He : e > 0) : a / (b * e) ≤ c / (d * e) :=
+  sorry
+  /-
+    begin
+      rewrite [!field.div_mul_eq_div_mul_one_div Hb (ne_of_gt He),
+               !field.div_mul_eq_div_mul_one_div Hd (ne_of_gt He)],
+      apply mul_le_mul_of_nonneg_right H,
+      apply le_of_lt,
+      apply one_div_pos_of_pos He
+    end
+  -/
+
+  theorem exists_add_lt_and_pos_of_lt (H : b < a) : ∃ c : A, b + c < a ∧ c > 0 :=
+  sorry
+  /-
+  exists.intro ((a - b) / (1 + 1))
+      (and.intro (have H2 : a + a > (b + b) + (a - b), from calc
+        a + a > b + a       : add_lt_add_right H _
+        ... = b + a + b - b : by rewrite add_sub_cancel
+        ... = b + b + a - b : by rewrite add.right_comm
+        ... = (b + b) + (a - b) : by rewrite add_sub,
+      have H3 : (a + a) / 2 > ((b + b) + (a - b)) / 2,
+        from div_lt_div_of_lt_of_pos H2 two_pos,
+      by rewrite [one_add_one_eq_two, sub_eq_add_neg, add_self_div_two at H3, -div_add_div_same at H3, add_self_div_two at H3];
+           exact H3)
+      (div_pos_of_pos_of_pos (iff.mpr !sub_pos_iff_lt H) two_pos))
+  -/
+
+  theorem ge_of_forall_ge_sub {a b : A} (H : ∀ ε : A, ε > 0 → a ≥ b - ε) : a ≥ b :=
+  sorry
+  /-
+  begin
+    apply le_of_not_gt,
+    intro Hb,
+    cases exists_add_lt_and_pos_of_lt Hb with [c, Hc],
+    let Hc' := H c (and.right Hc),
+    apply (not_le_of_gt (and.left Hc)) (iff.mpr !le_add_iff_sub_right_le Hc')
+  end
+  -/
+
+end linear_ordered_field
+
+structure discrete_linear_ordered_field [class] (A : Type) extends linear_ordered_field A,
+  decidable_linear_ordered_comm_ring A :=
+  (inv_zero : inv zero = zero)
+
+section discrete_linear_ordered_field
+
+  variable {A : Type}
+  variables [s : discrete_linear_ordered_field A] {a b c : A}
+  include s
+
+  definition dec_eq_of_dec_lt : ∀ x y : A, decidable (x = y) :=
+    take x y,
+    decidable.by_cases
+    (assume H : x < y, decidable.ff (ne_of_lt H))
+    (assume H : ¬ x < y,
+      decidable.by_cases
+      (assume H' : y < x, decidable.ff (ne.symm (ne_of_lt H')))
+      (assume H' : ¬ y < x,
+        decidable.tt (le.antisymm (le_of_not_gt H') (le_of_not_gt H))))
+
+  attribute [instance]
+  definition discrete_linear_ordered_field.to_discrete_field :  discrete_field A :=
+     ⦃ discrete_field, s, has_decidable_eq := dec_eq_of_dec_lt⦄
+
+    theorem pos_of_one_div_pos (H : 0 < 1 / a) : 0 < a :=
+    have H1 : 0 < 1 / (1 / a), from one_div_pos_of_pos H,
+    have H2 : 1 / a ≠ 0, from
+      (assume H3 : 1 / a = 0,
+      have H4 : 1 / (1 / a) = 0, from symm H3 ▸ div_zero 1,
+      absurd H4 (ne.symm (ne_of_lt H1))),
+    (division_ring.one_div_one_div (ne_zero_of_one_div_ne_zero H2)) ▸ H1
+
+  theorem neg_of_one_div_neg (H : 1 / a < 0) : a < 0 :=
+    have H1 : 0 < - (1 / a), from neg_pos_of_neg H,
+    have Ha : a ≠ 0, from ne_zero_of_one_div_ne_zero (ne_of_lt H),
+    have H2 : 0 < 1 / (-a), from symm (division_ring.one_div_neg_eq_neg_one_div Ha) ▸ H1,
+    have H3 : 0 < -a, from pos_of_one_div_pos H2,
+    neg_of_neg_pos H3
+
+  theorem le_of_one_div_le_one_div (H : 0 < a) (Hl : 1 / a ≤ 1 / b) : b ≤ a :=
+    have Hb : 0 < b, from pos_of_one_div_pos (calc
+      0   < 1 / a : one_div_pos_of_pos H
+      ... ≤ 1 / b : Hl),
+    have H' : 1 ≤ a / b, from (calc
+      1   = a / a       : eq.symm (div_self (ne.symm (ne_of_lt H)))
+      ... = a * (1 / a) : div_eq_mul_one_div a a
+      ... ≤ a * (1 / b) : mul_le_mul_of_nonneg_left Hl (le_of_lt H)
+      ... = a / b       : eq.symm $ div_eq_mul_one_div a b
+      ), le_of_one_le_div Hb H'
+
+  theorem le_of_one_div_le_one_div_of_neg (H : b < 0) (Hl : 1 / a ≤ 1 / b) : b ≤ a :=
+  sorry
+  /-
+    have Ha : a ≠ 0, from ne_of_lt (neg_of_one_div_neg (calc
+      1 / a ≤ 1 / b : Hl
+        ... < 0     : one_div_neg_of_neg H)),
+    have H'   : -b > 0,                from neg_pos_of_neg H,
+    have Hl'  : - (1 / b) ≤ - (1 / a), from neg_le_neg Hl,
+    have Hl'' : 1 / - b ≤ 1 / - a,     from calc
+      1 / -b = - (1 / b) : by rewrite [division_ring.one_div_neg_eq_neg_one_div (ne_of_lt H)]
+         ... ≤ - (1 / a) : Hl'
+         ... = 1 / -a    : by rewrite [division_ring.one_div_neg_eq_neg_one_div Ha],
+    le_of_neg_le_neg (le_of_one_div_le_one_div H' Hl'')
+  -/
+
+  theorem lt_of_one_div_lt_one_div (H : 0 < a) (Hl : 1 / a < 1 / b) : b < a :=
+    have Hb : 0 < b, from pos_of_one_div_pos (calc
+      0   < 1 / a : one_div_pos_of_pos H
+      ... < 1 / b : Hl),
+    have H : 1 < a / b, from (calc
+      1   = a / a       : eq.symm (div_self (ne.symm (ne_of_lt H)))
+      ... = a * (1 / a) : div_eq_mul_one_div a a
+      ... < a * (1 / b) : mul_lt_mul_of_pos_left Hl H
+      ... = a / b       : eq.symm $ div_eq_mul_one_div a b),
+      lt_of_one_lt_div Hb H
+
+  theorem lt_of_one_div_lt_one_div_of_neg (H : b < 0) (Hl : 1 / a < 1 / b) : b < a :=
+    have H1 : b ≤ a, from le_of_one_div_le_one_div_of_neg H (le_of_lt Hl),
+    have Hn : b ≠ a, from
+      (assume Hn' : b = a,
+      have Hl' : 1 / a = 1 / b, from Hn' ▸ refl _,
+      absurd Hl' (ne_of_lt Hl)),
+    lt_of_le_of_ne H1 Hn
+
+  theorem one_div_lt_one_div_of_lt (Ha : 0 < a) (H : a < b) : 1 / b < 1 / a :=
+    lt_of_not_ge
+      (assume H',
+      absurd H (not_lt_of_ge (le_of_one_div_le_one_div Ha H')))
+
+  theorem one_div_le_one_div_of_le (Ha : 0 < a) (H : a ≤ b) : 1 / b ≤ 1 / a :=
+    le_of_not_gt
+      (assume H',
+      absurd H (not_le_of_gt (lt_of_one_div_lt_one_div Ha H')))
+
+  theorem one_div_lt_one_div_of_lt_of_neg (Hb : b < 0) (H : a < b) : 1 / b < 1 / a :=
+    lt_of_not_ge
+      (assume H',
+      absurd H (not_lt_of_ge (le_of_one_div_le_one_div_of_neg Hb H')))
+
+  theorem one_div_le_one_div_of_le_of_neg (Hb : b < 0) (H : a ≤ b) : 1 / b ≤ 1 / a :=
+    le_of_not_gt
+      (assume H',
+      absurd H (not_le_of_gt (lt_of_one_div_lt_one_div_of_neg Hb H')))
+
+  theorem one_div_le_of_one_div_le_of_pos (Ha : a > 0) (H : 1 / a ≤ b) : 1 / b ≤ a :=
+  sorry
+  /-
+    begin
+      rewrite -(one_div_one_div a),
+      apply one_div_le_one_div_of_le,
+      apply one_div_pos_of_pos,
+      repeat assumption
+    end
+  -/
+
+  theorem one_div_le_of_one_div_le_of_neg (Ha : b < 0) (H : 1 / a ≤ b) : 1 / b ≤ a :=
+  sorry
+  /-
+    begin
+      rewrite -(one_div_one_div a),
+      apply one_div_le_one_div_of_le_of_neg,
+      repeat assumption
+    end
+  -/
+
+  theorem one_lt_one_div (H1 : 0 < a) (H2 : a < 1) : 1 < 1 / a :=
+    one_div_one ▸ one_div_lt_one_div_of_lt H1 H2
+
+  theorem one_le_one_div (H1 : 0 < a) (H2 : a ≤ 1) : 1 ≤ 1 / a :=
+    one_div_one ▸ one_div_le_one_div_of_le H1 H2
+
+  theorem one_div_lt_neg_one (H1 : a < 0) (H2 : -1 < a) : 1 / a < -1 :=
+    one_div_neg_one_eq_neg_one ▸ one_div_lt_one_div_of_lt_of_neg H1 H2
+
+  theorem one_div_le_neg_one (H1 : a < 0) (H2 : -1 ≤ a) : 1 / a ≤ -1 :=
+    one_div_neg_one_eq_neg_one ▸ one_div_le_one_div_of_le_of_neg H1 H2
+
+  theorem div_lt_div_of_pos_of_lt_of_pos (Hb : 0 < b) (H : b < a) (Hc : 0 < c) : c / a < c / b :=
+  sorry
+  /-
+    begin
+      apply iff.mp !sub_neg_iff_lt,
+      rewrite [div_eq_mul_one_div, {c / b}div_eq_mul_one_div, -mul_sub_left_distrib],
+      apply mul_neg_of_pos_of_neg,
+      exact Hc,
+      apply iff.mpr !sub_neg_iff_lt,
+      apply one_div_lt_one_div_of_lt,
+      repeat assumption
+    end
+  -/
+
+  theorem div_mul_le_div_mul_of_div_le_div_pos' {d e : A} (H : a / b ≤ c / d)
+          (He : e > 0) : a / (b * e) ≤ c / (d * e) :=
+  sorry
+  /-
+    begin
+      rewrite [2 div_mul_eq_div_mul_one_div],
+      apply mul_le_mul_of_nonneg_right H,
+      apply le_of_lt,
+      apply one_div_pos_of_pos He
+    end
+  -/
+
+  theorem abs_div (a b : A) : abs (a / b) = abs a / abs b :=
+  sorry
+  /-
+  decidable.by_cases
+    (suppose b = 0, by rewrite [this, abs_zero, *div_zero, abs_zero])
+    (suppose b ≠ 0,
+      have abs b ≠ 0, from assume H, this (eq_zero_of_abs_eq_zero H),
+      eq_div_of_mul_eq _ _ this
+        (show abs (a / b) * abs b = abs a, by rewrite [-abs_mul, div_mul_cancel _ `b ≠ 0`]))
+  -/
+
+  theorem abs_one_div (a : A) : abs (1 / a) = 1 / abs a :=
+  sorry -- by rewrite [abs_div, abs_of_nonneg (zero_le_one : 1 ≥ (0 : A))]
+
+  theorem sign_eq_div_abs (a : A) : sign a = a / (abs a) :=
+  sorry
+  /-
+  decidable.by_cases
+    (suppose a = 0, by subst a; rewrite [zero_div, sign_zero])
+    (suppose a ≠ 0,
+      have abs a ≠ 0, from assume H, this (eq_zero_of_abs_eq_zero H),
+      !eq_div_of_mul_eq this !eq_sign_mul_abs⁻¹)
+  -/
+
+  theorem add_quarters (a : A) : a / 4 + a / 4 = a / 2 :=
+  sorry
+  /-
+    have H4 : (4 : A) = 2 * 2, by norm_num,
+    calc
+      a / 4 + a / 4 = (a + a) / (2 * 2)         : by rewrite [-H4, div_add_div_same]
+                ... = (a * 1 + a * 1) / (2 * 2) : by rewrite mul_one
+                ... = (a * (1 + 1)) / (2 * 2)   : by rewrite left_distrib
+                ... = (a * 2) / (2 * 2)         : rfl
+                ... = ((a * 2) / 2) / 2         : by rewrite -div_div_eq_div_mul
+                ... = a / 2                     : by rewrite (mul_div_cancel a two_ne_zero)
+  -/
+
+  lemma div_two_add_div_four_lt {a : A} (H : a > 0) : a / 2 + a / 4 < a :=
+  sorry
+  /-
+  begin
+    replace (4 : A) with (2 : A) + 2,
+    have Hne : (2 + 2 : A) ≠ 0, from ne_of_gt four_pos,
+    krewrite (div_add_div _ _ two_ne_zero Hne),
+    have Hnum : (2 + 2 + 2) / (2 * (2 + 2)) = (3 : A) / 4, by norm_num,
+    rewrite [{2 * a}mul.comm, -left_distrib, mul_div_assoc, -mul_one a at {2}], krewrite Hnum,
+    apply mul_lt_mul_of_pos_left,
+    apply div_lt_of_mul_lt_of_pos,
+    apply four_pos,
+    rewrite one_mul,
+    replace (3 : A) with (2 : A) + 1,
+    replace (4 : A) with (2 : A) + 2,
+    apply add_lt_add_left,
+    apply two_gt_one,
+    exact H
+  end
+  -/
+end discrete_linear_ordered_field

old_library/algebra/ordered_ring.lean

@@ -0,0 +1,875 @@
+/-
+Copyright (c) 2014 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad
+
+Here an "ordered_ring" is partially ordered ring, which is ordered with respect to both a weak
+order and an associated strict order. Our numeric structures (int, rat, and real) will be instances
+of "linear_ordered_comm_ring". This development is modeled after Isabelle's library.
+-/
+import algebra.ordered_group algebra.ring
+open eq
+
+variable {A : Type}
+
+private definition absurd_a_lt_a {B : Type} {a : A} [s : strict_order A] (H : a < a) : B :=
+absurd H (lt.irrefl a)
+
+/- semiring structures -/
+
+structure ordered_semiring [class] (A : Type)
+  extends semiring A, ordered_cancel_comm_monoid A :=
+(mul_le_mul_of_nonneg_left: ∀a b c, le a b → le zero c → le (mul c a) (mul c b))
+(mul_le_mul_of_nonneg_right: ∀a b c, le a b → le zero c → le (mul a c) (mul b c))
+(mul_lt_mul_of_pos_left: ∀a b c, lt a b → lt zero c → lt (mul c a) (mul c b))
+(mul_lt_mul_of_pos_right: ∀a b c, lt a b → lt zero c → lt (mul a c) (mul b c))
+
+section
+  variable [s : ordered_semiring A]
+  variables (a b c d e : A)
+  include s
+
+  theorem mul_le_mul_of_nonneg_left {a b c : A} (Hab : a ≤ b) (Hc : 0 ≤ c) : c * a ≤ c * b :=
+  ordered_semiring.mul_le_mul_of_nonneg_left a b c Hab Hc
+
+  theorem mul_le_mul_of_nonneg_right {a b c : A} (Hab : a ≤ b) (Hc : 0 ≤ c) : a * c ≤ b * c :=
+  ordered_semiring.mul_le_mul_of_nonneg_right a b c Hab Hc
+
+  -- TODO: there are four variations, depending on which variables we assume to be nonneg
+  theorem mul_le_mul {a b c d : A} (Hac : a ≤ c) (Hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) :
+    a * b ≤ c * d :=
+  calc
+    a * b ≤ c * b : mul_le_mul_of_nonneg_right Hac nn_b
+      ... ≤ c * d : mul_le_mul_of_nonneg_left Hbd nn_c
+
+  theorem mul_nonneg {a b : A} (Ha : a ≥ 0) (Hb : b ≥ 0) : a * b ≥ 0 :=
+  sorry
+  /-
+  begin
+    have H : 0 * b ≤ a * b, from mul_le_mul_of_nonneg_right Ha Hb,
+    rewrite zero_mul at H,
+    exact H
+  end
+  -/
+
+  theorem mul_nonpos_of_nonneg_of_nonpos {a b : A} (Ha : a ≥ 0) (Hb : b ≤ 0) : a * b ≤ 0 :=
+  sorry
+  /-
+  begin
+    have H : a * b ≤ a * 0, from mul_le_mul_of_nonneg_left Hb Ha,
+    rewrite mul_zero at H,
+    exact H
+  end
+  -/
+
+  theorem mul_nonpos_of_nonpos_of_nonneg {a b : A} (Ha : a ≤ 0) (Hb : b ≥ 0) : a * b ≤ 0 :=
+  sorry
+  /-
+  begin
+    have H : a * b ≤ 0 * b, from mul_le_mul_of_nonneg_right Ha Hb,
+    rewrite zero_mul at H,
+    exact H
+  end
+  -/
+
+  theorem mul_lt_mul_of_pos_left {a b c : A} (Hab : a < b) (Hc : 0 < c) : c * a < c * b :=
+  ordered_semiring.mul_lt_mul_of_pos_left a b c Hab Hc
+
+  theorem mul_lt_mul_of_pos_right {a b c : A} (Hab : a < b) (Hc : 0 < c) : a * c < b * c :=
+  ordered_semiring.mul_lt_mul_of_pos_right a b c Hab Hc
+
+  -- TODO: once again, there are variations
+  theorem mul_lt_mul {a b c d : A} (Hac : a < c) (Hbd : b ≤ d) (pos_b : 0 < b) (nn_c : 0 ≤ c) :
+    a * b < c * d :=
+  calc
+    a * b < c * b : mul_lt_mul_of_pos_right Hac pos_b
+      ... ≤ c * d : mul_le_mul_of_nonneg_left Hbd nn_c
+
+  theorem mul_lt_mul' {a b c d : A} (H1 : a < c) (H2 : b < d) (H3 : b ≥ 0) (H4 : c > 0) :
+        a * b < c * d :=
+  calc
+    a * b ≤ c * b : mul_le_mul_of_nonneg_right (le_of_lt H1) H3
+      ... < c * d : mul_lt_mul_of_pos_left H2 H4
+
+  theorem mul_pos {a b : A} (Ha : a > 0) (Hb : b > 0) : a * b > 0 :=
+  sorry
+  /-
+  begin
+    have H : 0 * b < a * b, from mul_lt_mul_of_pos_right Ha Hb,
+    rewrite zero_mul at H,
+    exact H
+  end
+  -/
+
+  theorem mul_neg_of_pos_of_neg {a b : A} (Ha : a > 0) (Hb : b < 0) : a * b < 0 :=
+  sorry
+  /-
+  begin
+    have H : a * b < a * 0, from mul_lt_mul_of_pos_left Hb Ha,
+    rewrite mul_zero at H,
+    exact H
+  end
+  -/
+
+  theorem mul_neg_of_neg_of_pos {a b : A} (Ha : a < 0) (Hb : b > 0) : a * b < 0 :=
+  sorry
+  /-
+  begin
+    have H : a * b < 0 * b, from mul_lt_mul_of_pos_right Ha Hb,
+    rewrite zero_mul at  H,
+    exact H
+  end
+  -/
+
+  theorem mul_self_lt_mul_self {a b : A} (H1 : 0 ≤ a) (H2 : a < b) : a * a < b * b :=
+  mul_lt_mul' H2 H2 H1 (lt_of_le_of_lt H1 H2)
+end
+
+structure linear_ordered_semiring [class] (A : Type)
+  extends ordered_semiring A, linear_strong_order_pair A :=
+(zero_lt_one : lt zero one)
+
+section
+  variable [s : linear_ordered_semiring A]
+  variables {a b c : A}
+  include s
+
+  theorem zero_lt_one : 0 < (1:A) := linear_ordered_semiring.zero_lt_one A
+
+  theorem lt_of_mul_lt_mul_left (H : c * a < c * b) (Hc : c ≥ 0) : a < b :=
+  lt_of_not_ge
+    (assume H1 : b ≤ a,
+      have H2 : c * b ≤ c * a, from mul_le_mul_of_nonneg_left H1 Hc,
+      not_lt_of_ge H2 H)
+
+  theorem lt_of_mul_lt_mul_right (H : a * c < b * c) (Hc : c ≥ 0) : a < b :=
+  lt_of_not_ge
+    (assume H1 : b ≤ a,
+      have H2 : b * c ≤ a * c, from mul_le_mul_of_nonneg_right H1 Hc,
+      not_lt_of_ge H2 H)
+
+  theorem le_of_mul_le_mul_left (H : c * a ≤ c * b) (Hc : c > 0) : a ≤ b :=
+  le_of_not_gt
+    (assume H1 : b < a,
+      have H2 : c * b < c * a, from mul_lt_mul_of_pos_left H1 Hc,
+      not_le_of_gt H2 H)
+
+  theorem le_of_mul_le_mul_right (H : a * c ≤ b * c) (Hc : c > 0) : a ≤ b :=
+  le_of_not_gt
+    (assume H1 : b < a,
+      have H2 : b * c < a * c, from mul_lt_mul_of_pos_right H1 Hc,
+      not_le_of_gt H2 H)
+
+  theorem le_iff_mul_le_mul_left (a b : A) {c : A} (H : c > 0) : a ≤ b ↔ c * a ≤ c * b :=
+  iff.intro
+    (assume H', mul_le_mul_of_nonneg_left H' (le_of_lt H))
+    (assume H', le_of_mul_le_mul_left H' H)
+
+  theorem le_iff_mul_le_mul_right (a b : A) {c : A} (H : c > 0) : a ≤ b ↔ a * c ≤ b * c :=
+  iff.intro
+    (assume H', mul_le_mul_of_nonneg_right H' (le_of_lt H))
+    (assume H', le_of_mul_le_mul_right H' H)
+
+  theorem pos_of_mul_pos_left (H : 0 < a * b) (H1 : 0 ≤ a) : 0 < b :=
+  lt_of_not_ge
+    (assume H2 : b ≤ 0,
+      have H3 : a * b ≤ 0, from mul_nonpos_of_nonneg_of_nonpos H1 H2,
+      not_lt_of_ge H3 H)
+
+  theorem pos_of_mul_pos_right (H : 0 < a * b) (H1 : 0 ≤ b) : 0 < a :=
+  lt_of_not_ge
+    (assume H2 : a ≤ 0,
+      have H3 : a * b ≤ 0, from mul_nonpos_of_nonpos_of_nonneg H2 H1,
+      not_lt_of_ge H3 H)
+
+  theorem nonneg_of_mul_nonneg_left (H : 0 ≤ a * b) (H1 : 0 < a) : 0 ≤ b :=
+  le_of_not_gt
+    (assume H2 : b < 0,
+      not_le_of_gt (mul_neg_of_pos_of_neg H1 H2) H)
+
+  theorem nonneg_of_mul_nonneg_right (H : 0 ≤ a * b) (H1 : 0 < b) : 0 ≤ a :=
+  le_of_not_gt
+    (assume H2 : a < 0,
+      not_le_of_gt (mul_neg_of_neg_of_pos H2 H1) H)
+
+  theorem neg_of_mul_neg_left (H : a * b < 0) (H1 : 0 ≤ a) : b < 0 :=
+  lt_of_not_ge
+    (assume H2 : b ≥ 0,
+      not_lt_of_ge (mul_nonneg H1 H2) H)
+
+  theorem neg_of_mul_neg_right (H : a * b < 0) (H1 : 0 ≤ b) : a < 0 :=
+  lt_of_not_ge
+    (assume H2 : a ≥ 0,
+      not_lt_of_ge (mul_nonneg H2 H1) H)
+
+  theorem nonpos_of_mul_nonpos_left (H : a * b ≤ 0) (H1 : 0 < a) : b ≤ 0 :=
+  le_of_not_gt
+    (assume H2 : b > 0,
+      not_le_of_gt (mul_pos H1 H2) H)
+
+  theorem nonpos_of_mul_nonpos_right (H : a * b ≤ 0) (H1 : 0 < b) : a ≤ 0 :=
+  le_of_not_gt
+    (assume H2 : a > 0,
+      not_le_of_gt (mul_pos H2 H1) H)
+end
+
+structure decidable_linear_ordered_semiring [class] (A : Type)
+  extends linear_ordered_semiring A, decidable_linear_ordered_cancel_comm_monoid A
+
+/- ring structures -/
+
+structure ordered_ring [class] (A : Type)
+    extends ring A, ordered_comm_group A, zero_ne_one_class A :=
+(mul_nonneg : ∀a b, le zero a → le zero b → le zero (mul a b))
+(mul_pos : ∀a b, lt zero a → lt zero b → lt zero (mul a b))
+
+theorem ordered_ring.mul_le_mul_of_nonneg_left [s : ordered_ring A] {a b c : A}
+        (Hab : a ≤ b) (Hc : 0 ≤ c) : c * a ≤ c * b :=
+have H1 : 0 ≤ b - a, from iff.elim_right (sub_nonneg_iff_le b a) Hab,
+have H2 : 0 ≤ c * (b - a), from ordered_ring.mul_nonneg c (b - a) Hc H1,
+sorry
+/-
+begin
+  rewrite mul_sub_left_distrib at H2,
+  exact (iff.mp !sub_nonneg_iff_le H2)
+end
+-/
+
+theorem ordered_ring.mul_le_mul_of_nonneg_right [s : ordered_ring A] {a b c : A}
+        (Hab : a ≤ b) (Hc : 0 ≤ c) : a * c ≤ b * c  :=
+have H1 : 0 ≤ b - a, from iff.elim_right (sub_nonneg_iff_le b a) Hab,
+have H2 : 0 ≤ (b - a) * c, from ordered_ring.mul_nonneg (b - a) c H1 Hc,
+sorry
+/-
+begin
+  rewrite mul_sub_right_distrib at H2,
+  exact (iff.mp !sub_nonneg_iff_le H2)
+end
+-/
+
+theorem ordered_ring.mul_lt_mul_of_pos_left [s : ordered_ring A] {a b c : A}
+       (Hab : a < b) (Hc : 0 < c) : c * a < c * b :=
+have H1 : 0 < b - a, from iff.elim_right (sub_pos_iff_lt b a) Hab,
+have H2 : 0 < c * (b - a), from ordered_ring.mul_pos c (b - a) Hc H1,
+sorry
+/-
+begin
+  rewrite mul_sub_left_distrib at H2,
+  exact (iff.mp !sub_pos_iff_lt H2)
+end
+-/
+
+theorem ordered_ring.mul_lt_mul_of_pos_right [s : ordered_ring A] {a b c : A}
+       (Hab : a < b) (Hc : 0 < c) : a * c < b * c :=
+have H1 : 0 < b - a, from iff.elim_right (sub_pos_iff_lt b a) Hab,
+have H2 : 0 < (b - a) * c, from ordered_ring.mul_pos (b - a) c H1 Hc,
+sorry
+/-
+begin
+  rewrite mul_sub_right_distrib at H2,
+  exact (iff.mp !sub_pos_iff_lt H2)
+end
+-/
+
+attribute [instance]
+definition ordered_ring.to_ordered_semiring
+    [s : ordered_ring A] :
+  ordered_semiring A :=
+⦃ ordered_semiring, s,
+  mul_zero                   := mul_zero,
+  zero_mul                   := zero_mul,
+  add_left_cancel            := @add.left_cancel A _,
+  add_right_cancel           := @add.right_cancel A _,
+  le_of_add_le_add_left      := @le_of_add_le_add_left A _,
+  mul_le_mul_of_nonneg_left  := @ordered_ring.mul_le_mul_of_nonneg_left A _,
+  mul_le_mul_of_nonneg_right := @ordered_ring.mul_le_mul_of_nonneg_right A _,
+  mul_lt_mul_of_pos_left     := @ordered_ring.mul_lt_mul_of_pos_left A _,
+  mul_lt_mul_of_pos_right    := @ordered_ring.mul_lt_mul_of_pos_right A _,
+  lt_of_add_lt_add_left      := @lt_of_add_lt_add_left A _⦄
+
+section
+  variable [s : ordered_ring A]
+  variables {a b c : A}
+  include s
+
+  theorem mul_le_mul_of_nonpos_left (H : b ≤ a) (Hc : c ≤ 0) : c * a ≤ c * b :=
+  sorry
+  /-
+  have Hc' : -c ≥ 0, from iff.mpr !neg_nonneg_iff_nonpos Hc,
+  have H1 : -c * b ≤ -c * a, from mul_le_mul_of_nonneg_left H Hc',
+  have H2 : -(c * b) ≤ -(c * a),
+    begin
+      rewrite [-*neg_mul_eq_neg_mul at H1],
+      exact H1
+    end,
+  iff.mp !neg_le_neg_iff_le H2
+  -/
+
+  theorem mul_le_mul_of_nonpos_right (H : b ≤ a) (Hc : c ≤ 0) : a * c ≤ b * c :=
+  sorry
+  /-
+  have Hc' : -c ≥ 0, from iff.mpr !neg_nonneg_iff_nonpos Hc,
+  have H1 : b * -c ≤ a * -c, from mul_le_mul_of_nonneg_right H Hc',
+  have H2 : -(b * c) ≤ -(a * c),
+    begin
+      rewrite [-*neg_mul_eq_mul_neg at H1],
+      exact H1
+    end,
+  iff.mp !neg_le_neg_iff_le H2
+  -/
+
+  theorem mul_nonneg_of_nonpos_of_nonpos (Ha : a ≤ 0) (Hb : b ≤ 0) : 0 ≤ a * b :=
+  sorry
+  /-
+  begin
+    have H : 0 * b ≤ a * b, from mul_le_mul_of_nonpos_right Ha Hb,
+    rewrite zero_mul at H,
+    exact H
+  end
+  -/
+
+  theorem mul_lt_mul_of_neg_left (H : b < a) (Hc : c < 0) : c * a < c * b :=
+  sorry
+  /-
+  have Hc' : -c > 0, from iff.mpr !neg_pos_iff_neg Hc,
+  have H1 : -c * b < -c * a, from mul_lt_mul_of_pos_left H Hc',
+  have H2 : -(c * b) < -(c * a),
+    begin
+      rewrite [-*neg_mul_eq_neg_mul at H1],
+      exact H1
+    end,
+  iff.mp !neg_lt_neg_iff_lt H2
+  -/
+
+  theorem mul_lt_mul_of_neg_right (H : b < a) (Hc : c < 0) : a * c < b * c :=
+  sorry
+  /-
+  have Hc' : -c > 0, from iff.mpr !neg_pos_iff_neg Hc,
+  have H1 : b * -c < a * -c, from mul_lt_mul_of_pos_right H Hc',
+  have H2 : -(b * c) < -(a * c),
+    begin
+      rewrite [-*neg_mul_eq_mul_neg at H1],
+      exact H1
+    end,
+  iff.mp !neg_lt_neg_iff_lt H2
+  -/
+
+  theorem mul_pos_of_neg_of_neg (Ha : a < 0) (Hb : b < 0) : 0 < a * b :=
+  sorry
+  /-
+  begin
+    have H : 0 * b < a * b, from mul_lt_mul_of_neg_right Ha Hb,
+    rewrite zero_mul at H,
+    exact H
+  end
+  -/
+
+end
+
+-- TODO: we can eliminate mul_pos_of_pos, but now it is not worth the effort to redeclare the
+-- class instance
+structure linear_ordered_ring [class] (A : Type)
+    extends ordered_ring A, linear_strong_order_pair A :=
+  (zero_lt_one : lt zero one)
+
+attribute [instance]
+definition linear_ordered_ring.to_linear_ordered_semiring
+    [s : linear_ordered_ring A] :
+  linear_ordered_semiring A :=
+⦃ linear_ordered_semiring, s,
+  mul_zero                   := mul_zero,
+  zero_mul                   := zero_mul,
+  add_left_cancel            := @add.left_cancel A _,
+  add_right_cancel           := @add.right_cancel A _,
+  le_of_add_le_add_left      := @le_of_add_le_add_left A _,
+  mul_le_mul_of_nonneg_left  := @mul_le_mul_of_nonneg_left A _,
+  mul_le_mul_of_nonneg_right := @mul_le_mul_of_nonneg_right A _,
+  mul_lt_mul_of_pos_left     := @mul_lt_mul_of_pos_left A _,
+  mul_lt_mul_of_pos_right    := @mul_lt_mul_of_pos_right A _,
+  le_total                   := linear_ordered_ring.le_total,
+  lt_of_add_lt_add_left      := @lt_of_add_lt_add_left A _ ⦄
+
+structure linear_ordered_comm_ring [class] (A : Type) extends linear_ordered_ring A, comm_monoid A
+
+theorem linear_ordered_comm_ring.eq_zero_or_eq_zero_of_mul_eq_zero [s : linear_ordered_comm_ring A]
+        {a b : A} (H : a * b = 0) : a = 0 ∨ b = 0 :=
+sorry
+/-
+lt.by_cases
+  (assume Ha : 0 < a,
+    lt.by_cases
+      (assume Hb : 0 < b,
+        begin
+          have H1 : 0 < a * b, from mul_pos Ha Hb,
+          rewrite H at H1,
+          apply absurd_a_lt_a H1
+        end)
+      (assume Hb : 0 = b, or.inr (Hb⁻¹))
+      (assume Hb : 0 > b,
+        begin
+          have H1 : 0 > a * b, from mul_neg_of_pos_of_neg Ha Hb,
+          rewrite H at H1,
+          apply absurd_a_lt_a H1
+        end))
+  (assume Ha : 0 = a, or.inl (Ha⁻¹))
+  (assume Ha : 0 > a,
+    lt.by_cases
+      (assume Hb : 0 < b,
+        begin
+          have H1 : 0 > a * b, from mul_neg_of_neg_of_pos Ha Hb,
+          rewrite H at H1,
+          apply absurd_a_lt_a H1
+        end)
+      (assume Hb : 0 = b, or.inr (Hb⁻¹))
+      (assume Hb : 0 > b,
+        begin
+          have H1 : 0 < a * b, from mul_pos_of_neg_of_neg Ha Hb,
+          rewrite H at H1,
+          apply absurd_a_lt_a H1
+        end))
+-/
+
+-- Linearity implies no zero divisors. Doesn't need commutativity.
+attribute [instance]
+definition linear_ordered_comm_ring.to_integral_domain
+    [s: linear_ordered_comm_ring A] : integral_domain A :=
+⦃ integral_domain, s,
+  eq_zero_or_eq_zero_of_mul_eq_zero :=
+     @linear_ordered_comm_ring.eq_zero_or_eq_zero_of_mul_eq_zero A s ⦄
+
+section
+  variable [s : linear_ordered_ring A]
+  variables (a b c : A)
+  include s
+
+  theorem mul_self_nonneg : a * a ≥ 0 :=
+  or.elim (le.total 0 a)
+    (assume H : a ≥ 0, mul_nonneg H H)
+    (assume H : a ≤ 0, mul_nonneg_of_nonpos_of_nonpos H H)
+
+  theorem zero_le_one : 0 ≤ (1:A) :=
+  have H : 1 * 1 ≥ 0, from mul_self_nonneg (1:A),
+  sorry
+  /-
+  begin
+    rewrite one_mul at H,
+    assumption
+  end
+  -/
+
+  theorem pos_and_pos_or_neg_and_neg_of_mul_pos {a b : A} (Hab : a * b > 0) :
+    (a > 0 ∧ b > 0) ∨ (a < 0 ∧ b < 0) :=
+  sorry
+  /-
+  lt.by_cases
+    (assume Ha : 0 < a,
+      lt.by_cases
+        (assume Hb : 0 < b, or.inl (and.intro Ha Hb))
+        (assume Hb : 0 = b,
+          begin
+            rewrite [-Hb at Hab, mul_zero at Hab],
+            apply absurd_a_lt_a Hab
+          end)
+        (assume Hb : b < 0,
+          absurd Hab (lt.asymm (mul_neg_of_pos_of_neg Ha Hb))))
+    (assume Ha : 0 = a,
+      begin
+        rewrite [-Ha at Hab, zero_mul at Hab],
+        apply absurd_a_lt_a Hab
+      end)
+    (assume Ha : a < 0,
+      lt.by_cases
+        (assume Hb : 0 < b,
+          absurd Hab (lt.asymm (mul_neg_of_neg_of_pos Ha Hb)))
+        (assume Hb : 0 = b,
+          begin
+            rewrite [-Hb at Hab, mul_zero at Hab],
+            apply absurd_a_lt_a Hab
+          end)
+        (assume Hb : b < 0, or.inr (and.intro Ha Hb)))
+  -/
+
+  theorem gt_of_mul_lt_mul_neg_left {a b c : A} (H : c * a < c * b) (Hc : c ≤ 0) : a > b :=
+  sorry
+  /-
+    have nhc : -c ≥ 0, from neg_nonneg_of_nonpos Hc,
+    have H2 : -(c * b) < -(c * a), from iff.mpr (neg_lt_neg_iff_lt _ _) H,
+    have H3 : (-c) * b < (-c) * a, from calc
+      (-c) * b = - (c * b)    : by rewrite neg_mul_eq_neg_mul
+           ... < -(c * a)     : H2
+           ... = (-c) * a     : by rewrite neg_mul_eq_neg_mul,
+    lt_of_mul_lt_mul_left H3 nhc
+  -/
+
+  theorem zero_gt_neg_one : -1 < (0:A) :=
+    neg_zero ▸ (neg_lt_neg zero_lt_one)
+
+  theorem le_of_mul_le_of_ge_one {a b c : A} (H : a * c ≤ b) (Hb : b ≥ 0) (Hc : c ≥ 1) : a ≤ b :=
+  sorry
+  /-
+    have H' : a * c ≤ b * c, from calc
+      a * c ≤ b : H
+        ... = b * 1 : by rewrite mul_one
+        ... ≤ b * c : mul_le_mul_of_nonneg_left Hc Hb,
+    le_of_mul_le_mul_right H' (lt_of_lt_of_le zero_lt_one Hc)
+  -/
+
+  theorem nonneg_le_nonneg_of_squares_le {a b : A} (Ha : a ≥ 0) (Hb : b ≥ 0) (H : a * a ≤ b * b) :
+      a ≤ b :=
+  sorry
+  /-
+    begin
+      apply le_of_not_gt,
+      intro Hab,
+      note Hposa := lt_of_le_of_lt Hb Hab,
+      note H' := calc
+        b * b ≤ a * b : mul_le_mul_of_nonneg_right (le_of_lt Hab) Hb
+        ... < a * a : mul_lt_mul_of_pos_left Hab Hposa,
+      apply (not_le_of_gt H') H
+    end
+  -/
+
+end
+
+/- TODO: Isabelle's library has all kinds of cancelation rules for the simplifier.
+   Search on mult_le_cancel_right1 in Rings.thy. -/
+
+structure decidable_linear_ordered_comm_ring [class] (A : Type) extends linear_ordered_comm_ring A,
+    decidable_linear_ordered_comm_group A
+
+definition decidable_linear_ordered_comm_ring.to_decidable_linear_ordered_semiring
+    [instance] [s : decidable_linear_ordered_comm_ring A] :
+  decidable_linear_ordered_semiring A :=
+⦃decidable_linear_ordered_semiring, s, @linear_ordered_ring.to_linear_ordered_semiring A _⦄
+
+section
+  variable [s : decidable_linear_ordered_comm_ring A]
+  variables {a b c : A}
+  include s
+
+  definition sign (a : A) : A := lt.cases a 0 (-1) 0 1
+
+  theorem sign_of_neg (H : a < 0) : sign a = -1 := lt.cases_of_lt H
+
+  theorem sign_zero : sign 0 = (0:A) := lt.cases_of_eq rfl
+
+  theorem sign_of_pos (H : a > 0) : sign a = 1 := lt.cases_of_gt H
+
+  theorem sign_one : sign 1 = (1:A) := sign_of_pos zero_lt_one
+
+  theorem sign_neg_one : sign (-1) = -(1:A) := sign_of_neg (neg_neg_of_pos zero_lt_one)
+
+  theorem sign_sign (a : A) : sign (sign a) = sign a :=
+  sorry
+  /-
+  lt.by_cases
+    (assume H : a > 0,
+      calc
+        sign (sign a) = sign 1 : by rewrite (sign_of_pos H)
+                  ... = 1      : by rewrite sign_one
+                  ... = sign a : by rewrite (sign_of_pos H))
+    (assume H : 0 = a,
+      calc
+        sign (sign a) = sign (sign 0) : by rewrite H
+                  ... = sign 0        : by rewrite sign_zero at {1}
+                  ... = sign a        : by rewrite -H)
+    (assume H : a < 0,
+      calc
+        sign (sign a) = sign (-1)     : by rewrite (sign_of_neg H)
+                  ... = -1            : by rewrite sign_neg_one
+                  ... = sign a        : by rewrite (sign_of_neg H))
+  -/
+
+  theorem pos_of_sign_eq_one (H : sign a = 1) : a > 0 :=
+  sorry
+  /-
+  lt.by_cases
+    (assume H1 : 0 < a, H1)
+    (assume H1 : 0 = a,
+      begin
+        rewrite [-H1 at H, sign_zero at H],
+        apply absurd H zero_ne_one
+      end)
+    (assume H1 : 0 > a,
+      have H2 : -1 = 1, from (sign_of_neg H1)⁻¹ ⬝ H,
+      absurd ((eq_zero_of_neg_eq H2)⁻¹) zero_ne_one)
+  -/
+
+  theorem eq_zero_of_sign_eq_zero (H : sign a = 0) : a = 0 :=
+  sorry
+  /-
+  lt.by_cases
+    (assume H1 : 0 < a,
+      absurd (H⁻¹ ⬝ sign_of_pos H1) zero_ne_one)
+    (assume H1 : 0 = a, H1⁻¹)
+    (assume H1 : 0 > a,
+      have H2 : 0 = -1, from H⁻¹ ⬝ sign_of_neg H1,
+      have H3 : 1 = 0, from eq_neg_of_eq_neg H2 ⬝ neg_zero,
+      absurd (H3⁻¹) zero_ne_one)
+  -/
+
+  theorem neg_of_sign_eq_neg_one (H : sign a = -1) : a < 0 :=
+  sorry
+  /-
+  lt.by_cases
+    (assume H1 : 0 < a,
+      have H2 : -1 = 1, from H⁻¹ ⬝ (sign_of_pos H1),
+      absurd ((eq_zero_of_neg_eq H2)⁻¹) zero_ne_one)
+    (assume H1 : 0 = a,
+      have H2 : (0:A) = -1,
+        begin
+          rewrite [-H1 at H, sign_zero at H],
+          exact H
+        end,
+      have H3 : 1 = 0, from eq_neg_of_eq_neg H2 ⬝ neg_zero,
+      absurd (H3⁻¹) zero_ne_one)
+    (assume H1 : 0 > a, H1)
+  -/
+
+  theorem sign_neg (a : A) : sign (-a) = -(sign a) :=
+  sorry
+  /-
+  lt.by_cases
+    (assume H1 : 0 < a,
+      calc
+        sign (-a) = -1        : sign_of_neg (neg_neg_of_pos H1)
+              ... = -(sign a) : by rewrite (sign_of_pos H1))
+    (assume H1 : 0 = a,
+      calc
+        sign (-a) = sign (-0) : by rewrite H1
+              ... = sign 0    : by rewrite neg_zero
+              ... = 0         : by rewrite sign_zero
+              ... = -0        : by rewrite neg_zero
+              ... = -(sign 0) : by rewrite sign_zero
+              ... = -(sign a) : by rewrite -H1)
+    (assume H1 : 0 > a,
+      calc
+        sign (-a) = 1         : sign_of_pos (neg_pos_of_neg H1)
+              ... = -(-1)     : by rewrite neg_neg
+              ... = -(sign a) : by rewrite (sign_of_neg H1))
+  -/
+
+  theorem sign_mul (a b : A) : sign (a * b) = sign a * sign b :=
+  sorry
+  /-
+  lt.by_cases
+    (assume z_lt_a : 0 < a,
+      lt.by_cases
+       (assume z_lt_b : 0 < b,
+         by rewrite [sign_of_pos z_lt_a, sign_of_pos z_lt_b,
+                     sign_of_pos (mul_pos z_lt_a z_lt_b), one_mul])
+       (assume z_eq_b : 0 = b, by rewrite [-z_eq_b, mul_zero, *sign_zero, mul_zero])
+       (assume z_gt_b : 0 > b,
+         by rewrite [sign_of_pos z_lt_a, sign_of_neg z_gt_b,
+                     sign_of_neg (mul_neg_of_pos_of_neg z_lt_a z_gt_b), one_mul]))
+    (assume z_eq_a : 0 = a, by rewrite [-z_eq_a, zero_mul, *sign_zero, zero_mul])
+    (assume z_gt_a : 0 > a,
+      lt.by_cases
+       (assume z_lt_b : 0 < b,
+         by rewrite [sign_of_neg z_gt_a, sign_of_pos z_lt_b,
+                     sign_of_neg (mul_neg_of_neg_of_pos z_gt_a z_lt_b), mul_one])
+       (assume z_eq_b : 0 = b, by rewrite [-z_eq_b, mul_zero, *sign_zero, mul_zero])
+       (assume z_gt_b : 0 > b,
+         by rewrite [sign_of_neg z_gt_a, sign_of_neg z_gt_b,
+                     sign_of_pos (mul_pos_of_neg_of_neg z_gt_a z_gt_b),
+                     neg_mul_neg, one_mul]))
+  -/
+
+  theorem abs_eq_sign_mul (a : A) : abs a = sign a * a :=
+  sorry
+  /-
+  lt.by_cases
+    (assume H1 : 0 < a,
+      calc
+        abs a = a          : abs_of_pos H1
+        ... = 1 * a        : by rewrite one_mul
+        ... = sign a * a   : by rewrite (sign_of_pos H1))
+    (assume H1 : 0 = a,
+      calc
+        abs a = abs 0    : by rewrite H1
+        ... = 0          : by rewrite abs_zero
+        ... = 0 * a      : by rewrite zero_mul
+        ... = sign 0 * a : by rewrite sign_zero
+        ... = sign a * a : by rewrite H1)
+    (assume H1 : a < 0,
+      calc
+        abs a = -a         : abs_of_neg H1
+          ... = -1 * a     : by rewrite neg_eq_neg_one_mul
+          ... = sign a * a : by rewrite (sign_of_neg H1))
+  -/
+
+  theorem eq_sign_mul_abs (a : A) : a = sign a * abs a :=
+  sorry
+  /-
+  lt.by_cases
+    (assume H1 : 0 < a,
+      calc
+        a = abs a              : by rewrite (abs_of_pos H1)
+          ... = 1 * abs a      : by rewrite one_mul
+          ... = sign a * abs a : by rewrite (sign_of_pos H1))
+    (assume H1 : 0 = a,
+      calc
+        a = 0                  : H1⁻¹
+          ... = 0 * abs a      : by rewrite zero_mul
+          ... = sign 0 * abs a : by rewrite sign_zero
+          ... = sign a * abs a : by rewrite H1)
+    (assume H1 : a < 0,
+      calc
+        a = -(-a)              : by rewrite neg_neg
+          ... = -abs a         : by rewrite (abs_of_neg H1)
+          ... = -1 * abs a     : by rewrite neg_eq_neg_one_mul
+          ... = sign a * abs a : by rewrite (sign_of_neg H1))
+  -/
+
+  theorem abs_dvd_iff (a b : A) : abs a ∣ b ↔ a ∣ b :=
+  abs.by_cases (iff.refl $ a ∣ b) (neg_dvd_iff_dvd a b)
+
+  theorem abs_dvd_of_dvd {a b : A} : a ∣ b → abs a ∣ b :=
+  iff.mpr $ abs_dvd_iff a b
+
+  theorem dvd_abs_iff (a b : A) : a ∣ abs b ↔ a ∣ b :=
+  abs.by_cases (iff.refl $ a ∣ b) (dvd_neg_iff_dvd a b)
+
+  theorem dvd_abs_of_dvd {a b : A} : a ∣ b → a ∣ abs b :=
+  iff.mpr $ dvd_abs_iff a b
+
+  theorem abs_mul (a b : A) : abs (a * b) = abs a * abs b :=
+  sorry
+  /-
+  or.elim (le.total 0 a)
+    (assume H1 : 0 ≤ a,
+      or.elim (le.total 0 b)
+        (assume H2 : 0 ≤ b,
+          calc
+            abs (a * b) = a * b         : abs_of_nonneg (mul_nonneg H1 H2)
+                    ... = abs a * b     : by rewrite (abs_of_nonneg H1)
+                    ... = abs a * abs b : by rewrite (abs_of_nonneg H2))
+        (assume H2 : b ≤ 0,
+          calc
+            abs (a * b) = -(a * b)      : abs_of_nonpos (mul_nonpos_of_nonneg_of_nonpos H1 H2)
+                    ... = a * -b        : by rewrite neg_mul_eq_mul_neg
+                    ... = abs a * -b    : by rewrite (abs_of_nonneg H1)
+                    ... = abs a * abs b : by rewrite (abs_of_nonpos H2)))
+    (assume H1 : a ≤ 0,
+      or.elim (le.total 0 b)
+        (assume H2 : 0 ≤ b,
+          calc
+            abs (a * b) = -(a * b)      : abs_of_nonpos (mul_nonpos_of_nonpos_of_nonneg H1 H2)
+                    ... = -a * b        : by rewrite neg_mul_eq_neg_mul
+                    ... = abs a * b     : by rewrite (abs_of_nonpos H1)
+                    ... = abs a * abs b : by rewrite (abs_of_nonneg H2))
+        (assume H2 : b ≤ 0,
+          calc
+            abs (a * b) = a * b         : abs_of_nonneg (mul_nonneg_of_nonpos_of_nonpos H1 H2)
+                    ... = -a * -b       : by rewrite neg_mul_neg
+                    ... = abs a * -b    : by rewrite (abs_of_nonpos H1)
+                    ... = abs a * abs b : by rewrite (abs_of_nonpos H2)))
+  -/
+
+  theorem abs_mul_abs_self (a : A) : abs a * abs a = a * a :=
+  abs.by_cases rfl (neg_mul_neg a a)
+
+  theorem abs_mul_self (a : A) : abs (a * a) = a * a :=
+  sorry -- by rewrite [abs_mul, abs_mul_abs_self]
+
+  theorem sub_le_of_abs_sub_le_left (H : abs (a - b) ≤ c) : b - c ≤ a :=
+  sorry
+  /-
+    if Hz : 0 ≤ a - b then
+      (calc
+        a ≥ b : (iff.mp !sub_nonneg_iff_le) Hz
+      ... ≥ b - c : sub_le_of_nonneg _ (le.trans !abs_nonneg H))
+    else
+      (have Habs : b - a ≤ c, by rewrite [abs_of_neg (lt_of_not_ge Hz) at H, neg_sub at H]; apply H,
+       have Habs' : b ≤ c + a, from (iff.mpr !le_add_iff_sub_right_le) Habs,
+       (iff.mp !le_add_iff_sub_left_le) Habs')
+  -/
+
+  theorem sub_le_of_abs_sub_le_right (H : abs (a - b) ≤ c) : a - c ≤ b :=
+  sub_le_of_abs_sub_le_left (abs_sub a b ▸ H)
+
+  theorem sub_lt_of_abs_sub_lt_left (H : abs (a - b) < c) : b - c < a :=
+  sorry
+  /-
+    if Hz : 0 ≤ a - b then
+      (calc
+        a ≥ b : (iff.mp !sub_nonneg_iff_le) Hz
+      ... > b - c : sub_lt_of_pos _ (lt_of_le_of_lt !abs_nonneg H))
+    else
+      (have Habs : b - a < c, by rewrite [abs_of_neg (lt_of_not_ge Hz) at H, neg_sub at H]; apply H,
+       have Habs' : b < c + a, from lt_add_of_sub_lt_right Habs,
+       sub_lt_left_of_lt_add Habs')
+  -/
+
+  theorem sub_lt_of_abs_sub_lt_right (H : abs (a - b) < c) : a - c < b :=
+  sub_lt_of_abs_sub_lt_left (abs_sub a b ▸ H)
+
+  theorem abs_sub_square (a b : A) : abs (a - b) * abs (a - b) = a * a + b * b - (1 + 1) * a * b :=
+  sorry
+  /-
+    begin
+      rewrite [abs_mul_abs_self, *mul_sub_left_distrib, *mul_sub_right_distrib,
+               sub_eq_add_neg (a*b), sub_add_eq_sub_sub, sub_neg_eq_add, *right_distrib, sub_add_eq_sub_sub, *one_mul,
+               *add.assoc, {_ + b * b}add.comm, *sub_eq_add_neg],
+      rewrite [{a*a + b*b}add.comm],
+      rewrite [mul.comm b a, *add.assoc]
+    end
+  -/
+
+  theorem abs_abs_sub_abs_le_abs_sub (a b : A) : abs (abs a - abs b) ≤ abs (a - b) :=
+  sorry
+  /-
+  begin
+    apply nonneg_le_nonneg_of_squares_le,
+    repeat apply abs_nonneg,
+    rewrite [*abs_sub_square, *abs_abs, *abs_mul_abs_self],
+    apply sub_le_sub_left,
+    rewrite *mul.assoc,
+    apply mul_le_mul_of_nonneg_left,
+    rewrite -abs_mul,
+    apply le_abs_self,
+    apply le_of_lt,
+    apply add_pos,
+    apply zero_lt_one,
+    apply zero_lt_one
+  end
+  -/
+
+  lemma eq_zero_of_mul_self_add_mul_self_eq_zero {x y : A} (H : x * x + y * y = 0) : x = 0 :=
+  have x * x ≤ (0 : A), from calc
+    x * x ≤ x * x + y * y : le_add_of_nonneg_right (mul_self_nonneg y)
+      ... = 0             : H,
+  eq_zero_of_mul_self_eq_zero (le.antisymm this (mul_self_nonneg x))
+end
+
+/- TODO: Multiplication and one, starting with mult_right_le_one_le. -/
+
+namespace norm_num
+
+theorem pos_bit0_helper [s : linear_ordered_semiring A] (a : A) (H : a > 0) : bit0 a > 0 :=
+sorry -- by rewrite ↑bit0; apply add_pos H H
+
+theorem nonneg_bit0_helper [s : linear_ordered_semiring A] (a : A) (H : a ≥ 0) : bit0 a ≥ 0 :=
+sorry --   by rewrite ↑bit0; apply add_nonneg H H
+
+theorem pos_bit1_helper [s : linear_ordered_semiring A] (a : A) (H : a ≥ 0) : bit1 a > 0 :=
+sorry
+/-
+  begin
+    rewrite ↑bit1,
+    apply add_pos_of_nonneg_of_pos,
+    apply nonneg_bit0_helper _ H,
+    apply zero_lt_one
+  end
+-/
+
+theorem nonneg_bit1_helper [s : linear_ordered_semiring A] (a : A) (H : a ≥ 0) : bit1 a ≥ 0 :=
+sorry --  by apply le_of_lt; apply pos_bit1_helper _ H
+
+theorem nonzero_of_pos_helper [s : linear_ordered_semiring A] (a : A) (H : a > 0) : a ≠ 0 :=
+  ne_of_gt H
+
+theorem nonzero_of_neg_helper [s : linear_ordered_ring A] (a : A) (H : a ≠ 0) : -a ≠ 0 :=
+sorry --  begin intro Ha, apply H, apply eq_of_neg_eq_neg, rewrite neg_zero, exact Ha end
+
+end norm_num

old_library/algebra/priority.lean

@@ -0,0 +1,6 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+-/
+protected definition algebra.prio := num.sub std.priority.default 100

old_library/algebra/relation.lean

@@ -0,0 +1,122 @@
+/-
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+
+General properties of relations, and classes for equivalence relations and congruences.
+-/
+
+namespace relation
+
+/- properties of binary relations -/
+
+section
+  variables {T : Type} (R : T → T → Type)
+
+  definition reflexive : Type := ∀x, R x x
+  definition symmetric : Type := ∀⦃x y⦄, R x y → R y x
+  definition transitive : Type := ∀⦃x y z⦄, R x y → R y z → R x z
+end
+
+
+/- classes for equivalence relations -/
+
+structure is_reflexive [class] {T : Type} (R : T → T → Type) := (refl : reflexive R)
+structure is_symmetric [class] {T : Type} (R : T → T → Type) := (symm : symmetric R)
+structure is_transitive [class] {T : Type} (R : T → T → Type) := (trans : transitive R)
+
+structure is_equivalence [class] {T : Type} (R : T → T → Type)
+extends is_reflexive R, is_symmetric R, is_transitive R
+
+-- partial equivalence relation
+structure is_PER {T : Type} (R : T → T → Type) extends is_symmetric R, is_transitive R
+
+-- Generic notation. For example, is_refl R is the reflexivity of R, if that can be
+-- inferred by type class inference
+section
+  variables {T : Type} (R : T → T → Type)
+  definition rel_refl [C : is_reflexive R] := is_reflexive.refl R
+  definition rel_symm [C : is_symmetric R] := is_symmetric.symm R
+  definition rel_trans [C : is_transitive R] := is_transitive.trans R
+end
+
+
+/- classes for unary and binary congruences with respect to arbitrary relations -/
+
+structure is_congruence [class]
+  {T1 : Type} (R1 : T1 → T1 → Prop)
+  {T2 : Type} (R2 : T2 → T2 → Prop)
+  (f : T1 → T2) :=
+(congr : ∀{x y}, R1 x y → R2 (f x) (f y))
+
+structure is_congruence2 [class]
+  {T1 : Type} (R1 : T1 → T1 → Prop)
+  {T2 : Type} (R2 : T2 → T2 → Prop)
+  {T3 : Type} (R3 : T3 → T3 → Prop)
+  (f : T1 → T2 → T3) :=
+(congr2 : ∀{x1 y1 : T1} {x2 y2 : T2}, R1 x1 y1 → R2 x2 y2 → R3 (f x1 x2) (f y1 y2))
+
+namespace is_congruence
+
+  -- makes the type class explicit
+  definition app {T1 : Type} {R1 : T1 → T1 → Prop} {T2 : Type} {R2 : T2 → T2 → Prop}
+      {f : T1 → T2} (C : is_congruence R1 R2 f) ⦃x y : T1⦄ : R1 x y → R2 (f x) (f y) :=
+  is_congruence.rec (λu, u) C x y
+
+  definition app2 {T1 : Type} {R1 : T1 → T1 → Prop} {T2 : Type} {R2 : T2 → T2 → Prop}
+      {T3 : Type} {R3 : T3 → T3 → Prop}
+      {f : T1 → T2 → T3} (C : is_congruence2 R1 R2 R3 f) ⦃x1 y1 : T1⦄ ⦃x2 y2 : T2⦄ :
+    R1 x1 y1 → R2 x2 y2 → R3 (f x1 x2) (f y1 y2) :=
+  is_congruence2.rec (λu, u) C x1 y1 x2 y2
+
+  /- tools to build instances -/
+
+  definition compose
+      {T2 : Type} {R2 : T2 → T2 → Prop}
+      {T3 : Type} {R3 : T3 → T3 → Prop}
+      {g : T2 → T3} (C2 : is_congruence R2 R3 g)
+      ⦃T1 : Type⦄ {R1 : T1 → T1 → Prop}
+      {f : T1 → T2} [C1 : is_congruence R1 R2 f] :
+    is_congruence R1 R3 (λx, g (f x)) :=
+  is_congruence.mk (λx1 x2 H, app C2 (app C1 H))
+
+  definition compose21
+      {T2 : Type} {R2 : T2 → T2 → Prop}
+      {T3 : Type} {R3 : T3 → T3 → Prop}
+      {T4 : Type} {R4 : T4 → T4 → Prop}
+      {g : T2 → T3 → T4} (C3 : is_congruence2 R2 R3 R4 g)
+      ⦃T1 : Type⦄ {R1 : T1 → T1 → Prop}
+      {f1 : T1 → T2} [C1 : is_congruence R1 R2 f1]
+      {f2 : T1 → T3} [C2 : is_congruence R1 R3 f2] :
+    is_congruence R1 R4 (λx, g (f1 x) (f2 x)) :=
+  is_congruence.mk (λx1 x2 H, app2 C3 (app C1 H) (app C2 H))
+
+  definition const {T2 : Type} (R2 : T2 → T2 → Prop) (H : relation.reflexive R2)
+      ⦃T1 : Type⦄ (R1 : T1 → T1 → Prop) (c : T2) :
+    is_congruence R1 R2 (λu : T1, c) :=
+  is_congruence.mk (λx y H1, H c)
+
+end is_congruence
+
+attribute [instance]
+definition congruence_const {T2 : Type} (R2 : T2 → T2 → Prop)
+    [C : is_reflexive R2] ⦃T1 : Type⦄ (R1 : T1 → T1 → Prop) (c : T2) :
+  is_congruence R1 R2 (λu : T1, c) :=
+is_congruence.const R2 (is_reflexive.refl R2) R1 c
+
+attribute [instance]
+definition congruence_trivial {T : Type} (R : T → T → Prop) :
+  is_congruence R R (λu, u) :=
+is_congruence.mk (λx y H, H)
+
+
+/- relations that can be coerced to functions / implications-/
+
+structure mp_like [class] (R : Type → Type → Type) :=
+(app : Π{a b : Type}, R a b → (a → b))
+
+definition rel_mp (R : Type → Type → Type) [C : mp_like R] {a b : Type} (H : R a b) :=
+mp_like.app H
+
+
+end relation

old_library/algebra/ring.lean

@@ -0,0 +1,577 @@
+/-
+Copyright (c) 2014 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad, Leonardo de Moura
+
+Structures with multiplicative and additive components, including semirings, rings, and fields.
+The development is modeled after Isabelle's library.
+-/
+import algebra.group
+open eq
+
+variable {A : Type}
+
+/- auxiliary classes -/
+
+structure distrib [class] (A : Type) extends has_mul A, has_add A :=
+(left_distrib : ∀a b c, mul a (add b c) = add (mul a b) (mul a c))
+(right_distrib : ∀a b c, mul (add a b) c = add (mul a c) (mul b c))
+
+theorem left_distrib [distrib A] (a b c : A) : a * (b + c) = a * b + a * c :=
+distrib.left_distrib a b c
+
+theorem right_distrib [distrib A] (a b c : A) : (a + b) * c = a * c + b * c :=
+distrib.right_distrib a b c
+
+structure mul_zero_class [class] (A : Type) extends has_mul A, has_zero A :=
+(zero_mul : ∀a, mul zero a = zero)
+(mul_zero : ∀a, mul a zero = zero)
+
+attribute [simp]
+theorem zero_mul [mul_zero_class A] (a : A) : 0 * a = 0 := mul_zero_class.zero_mul a
+attribute [simp]
+theorem mul_zero [mul_zero_class A] (a : A) : a * 0 = 0 := mul_zero_class.mul_zero a
+
+structure zero_ne_one_class [class] (A : Type) extends has_zero A, has_one A :=
+(zero_ne_one : zero ≠ one)
+
+theorem zero_ne_one [s: zero_ne_one_class A] : 0 ≠ (1:A) := @zero_ne_one_class.zero_ne_one A s
+
+/- semiring -/
+
+structure semiring [class] (A : Type) extends add_comm_monoid A, monoid A, distrib A,
+    mul_zero_class A
+
+section semiring
+  variables [s : semiring A] (a b c : A)
+  include s
+
+  theorem one_add_one_eq_two : 1 + 1 = (2:A) :=
+  sorry -- by unfold bit0
+
+  theorem ne_zero_of_mul_ne_zero_right {a b : A} (H : a * b ≠ 0) : a ≠ 0 :=
+  sorry
+  /-
+  suppose a = 0,
+  have a * b = 0, by rewrite [this, zero_mul],
+  H this
+  -/
+
+  theorem ne_zero_of_mul_ne_zero_left {a b : A} (H : a * b ≠ 0) : b ≠ 0 :=
+  sorry
+  /-
+  suppose b = 0,
+  have a * b = 0, by rewrite [this, mul_zero],
+  H this
+  -/
+
+  local attribute right_distrib [simp]
+
+  theorem distrib_three_right (a b c d : A) : (a + b + c) * d = a * d + b * d + c * d :=
+  sorry -- by simp
+end semiring
+
+/- comm semiring -/
+
+structure comm_semiring [class] (A : Type) extends semiring A, comm_monoid A
+-- TODO: we could also define a cancelative comm_semiring, i.e. satisfying
+-- c ≠ 0 → c * a = c * b → a = b.
+
+section comm_semiring
+  variables [s : comm_semiring A] (a b c : A)
+  include s
+
+  protected definition algebra.dvd (a b : A) : Prop := ∃c, b = a * c
+
+  attribute [instance, priority algebra.prio]
+  definition comm_semiring_has_dvd : has_dvd A :=
+  has_dvd.mk algebra.dvd
+
+  theorem dvd.intro {a b c : A} (H : a * c = b) : a ∣ b :=
+  exists.intro _ (eq.symm H)
+
+  theorem dvd_of_mul_right_eq {a b c : A} (H : a * c = b) : a ∣ b := dvd.intro H
+
+  theorem dvd.intro_left {a b c : A} (H : c * a = b) : a ∣ b :=
+  sorry -- dvd.intro (by rewrite mul.comm at H; exact H)
+
+  theorem dvd_of_mul_left_eq {a b c : A} (H : c * a = b) : a ∣ b := dvd.intro_left H
+
+  theorem exists_eq_mul_right_of_dvd {a b : A} (H : a ∣ b) : ∃c, b = a * c := H
+
+  theorem dvd.elim {P : Prop} {a b : A} (H₁ : a ∣ b) (H₂ : ∀c, b = a * c → P) : P :=
+  exists.elim H₁ H₂
+
+  theorem exists_eq_mul_left_of_dvd {a b : A} (H : a ∣ b) : ∃c, b = c * a :=
+  dvd.elim H (take c, assume H1 : b = a * c, exists.intro c (eq.trans H1 (mul.comm a c)))
+
+  theorem dvd.elim_left {P : Prop} {a b : A} (H₁ : a ∣ b) (H₂ : ∀c, b = c * a → P) : P :=
+  exists.elim (exists_eq_mul_left_of_dvd H₁) (take c, assume H₃ : b = c * a, H₂ c H₃)
+
+  attribute [simp]
+  theorem dvd.refl : a ∣ a :=
+  dvd.intro (mul_one a)
+
+  theorem dvd.trans {a b c : A} (H₁ : a ∣ b) (H₂ : b ∣ c) : a ∣ c :=
+  sorry
+  /-
+  dvd.elim H₁
+    (take d, assume H₃ : b = a * d,
+      dvd.elim H₂
+        (take e, assume H₄ : c = b * e,
+          dvd.intro
+            (show a * (d * e) = c, by rewrite [-mul.assoc, -H₃, H₄])))
+  -/
+
+  theorem eq_zero_of_zero_dvd {a : A} (H : 0 ∣ a) : a = 0 :=
+    dvd.elim H (take c, assume H' : a = 0 * c, eq.trans H' (zero_mul c))
+
+  attribute [simp]
+  theorem dvd_zero : a ∣ 0 := dvd.intro (mul_zero a)
+
+  attribute [simp]
+  theorem one_dvd : 1 ∣ a := dvd.intro (one_mul a)
+
+  attribute [simp]
+  theorem dvd_mul_right : a ∣ a * b := dvd.intro rfl
+
+  attribute [simp]
+  theorem dvd_mul_left : a ∣ b * a :=
+  sorry -- by simp
+
+  theorem dvd_mul_of_dvd_left {a b : A} (H : a ∣ b) (c : A) : a ∣ b * c :=
+  sorry
+  /-
+  dvd.elim H
+    (take d,
+      suppose b = a * d,
+      dvd.intro
+        (show a * (d * c) = b * c, by simp))
+  -/
+
+  theorem dvd_mul_of_dvd_right {a b : A} (H : a ∣ b) (c : A) : a ∣ c * b :=
+  sorry -- begin rewrite mul.comm, exact dvd_mul_of_dvd_left H _ end
+
+  theorem mul_dvd_mul {a b c d : A} (dvd_ab : a ∣ b) (dvd_cd : c ∣ d) : a * c ∣ b * d :=
+  sorry
+  /-
+  dvd.elim dvd_ab
+    (take e, suppose b = a * e,
+      dvd.elim dvd_cd
+        (take f, suppose d = c * f,
+          dvd.intro
+            (show a * c * (e * f) = b * d,
+             by simp)))
+  -/
+
+  theorem dvd_of_mul_right_dvd {a b c : A} (H : a * b ∣ c) : a ∣ c :=
+  dvd.elim H (take d, assume Habdc : c = a * b * d, dvd.intro (eq.symm (eq.trans Habdc (mul.assoc a b d))))
+
+  theorem dvd_of_mul_left_dvd {a b c : A} (H : a * b ∣ c) : b ∣ c :=
+  sorry -- dvd_of_mul_right_dvd begin rewrite mul.comm at H, apply H end
+
+  theorem dvd_add {a b c : A} (Hab : a ∣ b) (Hac : a ∣ c) : a ∣ b + c :=
+  sorry
+  /-
+  dvd.elim Hab
+    (take d, suppose b = a * d,
+      dvd.elim Hac
+        (take e, suppose c = a * e,
+          dvd.intro (show a * (d + e) = b + c,
+                     by rewrite [left_distrib]; substvars)))
+  -/
+end comm_semiring
+
+/- ring -/
+
+structure ring [class] (A : Type) extends add_comm_group A, monoid A, distrib A
+
+attribute [simp]
+theorem ring.mul_zero [ring A] (a : A) : a * 0 = 0 :=
+sorry
+/-
+have a * 0 + 0 = a * 0 + a * 0, from calc
+  a * 0 + 0 = a * (0 + 0)   : by simp
+        ... = a * 0 + a * 0 : by rewrite left_distrib,
+show a * 0 = 0, from (add.left_cancel this)⁻¹
+-/
+
+attribute [simp]
+theorem ring.zero_mul [ring A] (a : A) : 0 * a = 0 :=
+sorry
+/-
+have 0 * a + 0 = 0 * a + 0 * a, from calc
+  0 * a + 0 = (0 + 0) * a   : by simp
+        ... = 0 * a + 0 * a : by rewrite right_distrib,
+show 0 * a = 0, from  (add.left_cancel this)⁻¹
+-/
+
+attribute [instance]
+definition ring.to_semiring [s : ring A] : semiring A :=
+⦃ semiring, s,
+  mul_zero := ring.mul_zero,
+  zero_mul := ring.zero_mul ⦄
+
+section
+  variables [s : ring A] (a b c d e : A)
+  include s
+
+  theorem neg_mul_eq_neg_mul : -(a * b) = -a * b :=
+  sorry
+  /-
+  neg_eq_of_add_eq_zero
+    begin
+      rewrite [-right_distrib, add.right_inv, zero_mul]
+    end
+  -/
+
+  theorem neg_mul_eq_mul_neg : -(a * b) = a * -b :=
+  sorry
+  /-
+   neg_eq_of_add_eq_zero
+     begin
+       rewrite [-left_distrib, add.right_inv, mul_zero]
+     end
+  -/
+
+  attribute [simp]
+  theorem neg_mul_eq_neg_mul_symm : - a * b = - (a * b) := eq.symm (neg_mul_eq_neg_mul a b)
+  attribute [simp]
+  theorem mul_neg_eq_neg_mul_symm : a * - b = - (a * b) := eq.symm (neg_mul_eq_mul_neg a b)
+
+  theorem neg_mul_neg : -a * -b = a * b :=
+  sorry -- by simp
+
+  theorem neg_mul_comm : -a * b = a * -b :=
+  sorry -- by simp
+
+  theorem neg_eq_neg_one_mul : -a = -1 * a :=
+  sorry -- by simp
+
+  theorem mul_sub_left_distrib : a * (b - c) = a * b - a * c :=
+  calc
+    a * (b - c) = a * b + a * -c : left_distrib a b (-c)
+            ... = a * b - a * c  : sorry -- by simp
+
+  theorem mul_sub_right_distrib : (a - b) * c = a * c - b * c :=
+  calc
+    (a - b) * c = a * c  + -b * c : right_distrib a (-b) c
+            ... = a * c - b * c   : sorry -- by simp
+
+  -- TODO: can calc mode be improved to make this easier?
+  -- TODO: there is also the other direction. It will be easier when we
+  -- have the simplifier.
+
+  theorem mul_add_eq_mul_add_iff_sub_mul_add_eq : a * e + c = b * e + d ↔ (a - b) * e + c = d :=
+  sorry
+  /-
+  calc
+    a * e + c = b * e + d ↔ a * e + c = d + b * e : by rewrite {b*e+_}add.comm
+      ... ↔ a * e + c - b * e = d : iff.symm !sub_eq_iff_eq_add
+      ... ↔ a * e - b * e + c = d : by rewrite sub_add_eq_add_sub
+      ... ↔ (a - b) * e + c = d   : by rewrite mul_sub_right_distrib
+  -/
+
+  theorem mul_add_eq_mul_add_of_sub_mul_add_eq : (a - b) * e + c = d → a * e + c = b * e + d :=
+  iff.mpr (mul_add_eq_mul_add_iff_sub_mul_add_eq a b c d e)
+
+  theorem sub_mul_add_eq_of_mul_add_eq_mul_add : a * e + c = b * e + d → (a - b) * e + c = d :=
+  iff.mp (mul_add_eq_mul_add_iff_sub_mul_add_eq a b c d e)
+
+  theorem mul_neg_one_eq_neg : a * (-1) = -a :=
+    have a + a * -1 = 0, from calc
+      a + a * -1 = a * 1 + a * -1 : sorry -- by simp
+             ... = a * (1 + -1)   : eq.symm (left_distrib a 1 (-1))
+             ... = 0              : sorry, -- by simp,
+    symm (neg_eq_of_add_eq_zero this)
+
+  theorem ne_zero_and_ne_zero_of_mul_ne_zero {a b : A} (H : a * b ≠ 0) : a ≠ 0 ∧ b ≠ 0 :=
+  sorry
+  /-
+    have a ≠ 0, from
+      (suppose a = 0,
+        have a * b = 0, by rewrite [this, zero_mul],
+        absurd this H),
+    have b ≠ 0, from
+      (suppose b = 0,
+        have a * b = 0, by rewrite [this, mul_zero],
+        absurd this H),
+    and.intro `a ≠ 0` `b ≠ 0`
+  -/
+end
+
+structure comm_ring [class] (A : Type) extends ring A, comm_semigroup A
+
+attribute [instance]
+definition comm_ring.to_comm_semiring [s : comm_ring A] : comm_semiring A :=
+⦃ comm_semiring, s,
+  mul_zero := mul_zero,
+  zero_mul := zero_mul ⦄
+
+section
+  variables [s : comm_ring A] (a b c d e : A)
+  include s
+
+  local attribute left_distrib right_distrib [simp]
+
+  theorem mul_self_sub_mul_self_eq : a * a - b * b = (a + b) * (a - b) :=
+  sorry -- by simp
+
+  theorem mul_self_sub_one_eq : a * a - 1 = (a + 1) * (a - 1) :=
+  sorry -- by simp
+
+  theorem add_mul_self_eq : (a + b) * (a + b) = a*a + 2*a*b + b*b :=
+  calc (a + b)*(a + b) = a*a + (1+1)*a*b + b*b : sorry -- by simp
+               ...     = a*a + 2*a*b + b*b     : sorry -- by rewrite one_add_one_eq_two
+
+  theorem dvd_neg_iff_dvd : (a ∣ -b) ↔ (a ∣ b) :=
+  sorry
+  /-
+  iff.intro
+    (suppose a ∣ -b,
+      dvd.elim this
+        (take c, suppose -b = a * c,
+          dvd.intro
+            (show a * -c = b,
+             by rewrite [-neg_mul_eq_mul_neg, -this, neg_neg])))
+    (suppose a ∣ b,
+      dvd.elim this
+        (take c, suppose b = a * c,
+          dvd.intro
+            (show a * -c = -b,
+             by rewrite [-neg_mul_eq_mul_neg, -this])))
+  -/
+
+  theorem dvd_neg_of_dvd : (a ∣ b) → (a ∣ -b) :=
+  iff.mpr (dvd_neg_iff_dvd a b)
+
+  theorem dvd_of_dvd_neg : (a ∣ -b) → (a ∣ b) :=
+  iff.mp (dvd_neg_iff_dvd a b)
+
+  theorem neg_dvd_iff_dvd : (-a ∣ b) ↔ (a ∣ b) :=
+  sorry
+  /-
+  iff.intro
+    (suppose -a ∣ b,
+      dvd.elim this
+        (take c, suppose b = -a * c,
+          dvd.intro
+            (show a * -c = b, by rewrite [-neg_mul_comm, this])))
+    (suppose a ∣ b,
+      dvd.elim this
+        (take c, suppose b = a * c,
+          dvd.intro
+            (show -a * -c = b, by rewrite [neg_mul_neg, this])))
+  -/
+
+  theorem neg_dvd_of_dvd : (a ∣ b) → (-a ∣ b) :=
+  iff.mpr (neg_dvd_iff_dvd a b)
+
+  theorem dvd_of_neg_dvd : (-a ∣ b) → (a ∣ b) :=
+  iff.mp (neg_dvd_iff_dvd a b)
+
+  theorem dvd_sub (H₁ : (a ∣ b)) (H₂ : (a ∣ c)) : (a ∣ b - c) :=
+  dvd_add H₁ (dvd_neg_of_dvd a c H₂)
+end
+
+/- integral domains -/
+
+structure no_zero_divisors [class] (A : Type) extends has_mul A, has_zero A :=
+(eq_zero_or_eq_zero_of_mul_eq_zero : ∀a b, mul a b = zero → a = zero ∨ b = zero)
+
+theorem eq_zero_or_eq_zero_of_mul_eq_zero {A : Type} [no_zero_divisors A] {a b : A}
+    (H : a * b = 0) :
+  a = 0 ∨ b = 0 :=
+no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero a b H
+
+theorem eq_zero_of_mul_self_eq_zero {A : Type} [no_zero_divisors A] {a : A} (H : a * a = 0) :
+  a = 0 :=
+or.elim (eq_zero_or_eq_zero_of_mul_eq_zero H) (assume H', H') (assume H', H')
+
+structure integral_domain [class] (A : Type) extends comm_ring A, no_zero_divisors A,
+    zero_ne_one_class A
+
+section
+  variables [s : integral_domain A] (a b c d e : A)
+  include s
+
+  theorem mul_ne_zero {a b : A} (H1 : a ≠ 0) (H2 : b ≠ 0) : a * b ≠ 0 :=
+  suppose a * b = 0,
+  or.elim (eq_zero_or_eq_zero_of_mul_eq_zero this) (assume H3, H1 H3) (assume H4, H2 H4)
+
+  theorem eq_of_mul_eq_mul_right {a b c : A} (Ha : a ≠ 0) (H : b * a = c * a) : b = c :=
+  sorry
+  /-
+  have b * a - c * a = 0, from iff.mp !eq_iff_sub_eq_zero H,
+  have (b - c) * a = 0, by rewrite [mul_sub_right_distrib, this],
+  have b - c = 0, from or_resolve_left (eq_zero_or_eq_zero_of_mul_eq_zero this) Ha,
+  iff.elim_right !eq_iff_sub_eq_zero this
+  -/
+
+  theorem eq_of_mul_eq_mul_left {a b c : A} (Ha : a ≠ 0) (H : a * b = a * c) : b = c :=
+  sorry
+  /-
+  have a * b - a * c = 0, from iff.mp !eq_iff_sub_eq_zero H,
+  have a * (b - c) = 0, by rewrite [mul_sub_left_distrib, this],
+  have b - c = 0, from or_resolve_right (eq_zero_or_eq_zero_of_mul_eq_zero this) Ha,
+  iff.elim_right !eq_iff_sub_eq_zero this
+  -/
+
+  -- TODO: do we want the iff versions?
+
+  theorem eq_zero_of_mul_eq_self_right {a b : A} (H₁ : b ≠ 1) (H₂ : a * b = a) : a = 0 :=
+  sorry
+  /-
+  have b - 1 ≠ 0, from
+    suppose b - 1 = 0,
+    have b = 0 + 1, from eq_add_of_sub_eq this,
+    have b = 1, by rewrite zero_add at this; exact this,
+    H₁ this,
+  have a * b - a = 0,   by simp,
+  have a * (b - 1) = 0, by rewrite [mul_sub_left_distrib, mul_one]; apply this,
+    show a = 0, from or_resolve_left (eq_zero_or_eq_zero_of_mul_eq_zero this) `b - 1 ≠ 0`
+  -/
+
+  theorem eq_zero_of_mul_eq_self_left {a b : A} (H₁ : b ≠ 1) (H₂ : b * a = a) : a = 0 :=
+  sorry --  eq_zero_of_mul_eq_self_right H₁ (begin rewrite mul.comm at H₂, exact H₂ end)
+
+  theorem mul_self_eq_mul_self_iff (a b : A) : a * a = b * b ↔ a = b ∨ a = -b :=
+  sorry
+  /-
+  iff.intro
+    (suppose a * a = b * b,
+      have (a - b) * (a + b) = 0,
+        by rewrite [mul.comm, -mul_self_sub_mul_self_eq, this, sub_self],
+      have a - b = 0 ∨ a + b = 0, from !eq_zero_or_eq_zero_of_mul_eq_zero this,
+      or.elim this
+        (suppose a - b = 0, or.inl (eq_of_sub_eq_zero this))
+        (suppose a + b = 0, or.inr (eq_neg_of_add_eq_zero this)))
+    (suppose a = b ∨ a = -b, or.elim this
+      (suppose a = b,  by rewrite this)
+      (suppose a = -b, by rewrite [this, neg_mul_neg]))
+  -/
+
+  theorem mul_self_eq_one_iff (a : A) : a * a = 1 ↔ a = 1 ∨ a = -1 :=
+  sorry
+  /-
+  have a * a = 1 * 1 ↔ a = 1 ∨ a = -1, from mul_self_eq_mul_self_iff a 1,
+  by rewrite mul_one at this; exact this
+  -/
+  -- TODO: c - b * c → c = 0 ∨ b = 1 and variants
+
+  theorem dvd_of_mul_dvd_mul_left {a b c : A} (Ha : a ≠ 0) (Hdvd : (a * b ∣ a * c)) : (b ∣ c) :=
+  sorry
+  /-
+  dvd.elim Hdvd
+    (take d,
+      suppose a * c = a * b * d,
+      have b * d = c, from eq_of_mul_eq_mul_left Ha begin rewrite -mul.assoc, symmetry, exact this end,
+      dvd.intro this)
+  -/
+
+  theorem dvd_of_mul_dvd_mul_right {a b c : A} (Ha : a ≠ 0) (Hdvd : (b * a ∣ c * a)) : (b ∣ c) :=
+  sorry
+  /-
+  dvd.elim Hdvd
+    (take d,
+      suppose c * a = b * a * d,
+      have b * d * a = c * a, from by rewrite [mul.right_comm, -this],
+      have b * d = c, from eq_of_mul_eq_mul_right Ha this,
+      dvd.intro this)
+  -/
+end
+
+namespace norm_num
+
+local attribute bit0 bit1 add1 [reducible]
+local attribute right_distrib left_distrib [simp]
+
+theorem mul_zero [mul_zero_class A] (a : A) : a * zero = zero :=
+sorry -- by simp
+
+theorem zero_mul [mul_zero_class A] (a : A) : zero * a = zero :=
+sorry -- by simp
+
+theorem mul_one [monoid A] (a : A) : a * one = a :=
+sorry -- by simp
+
+theorem mul_bit0 [distrib A] (a b : A) : a * (bit0 b) = bit0 (a * b) :=
+sorry -- by simp
+
+theorem mul_bit0_helper [distrib A] (a b t : A) (H : a * b = t) : a * (bit0 b) = bit0 t :=
+sorry -- by rewrite -H; simp
+
+theorem mul_bit1 [semiring A] (a b : A) : a * (bit1 b) = bit0 (a * b) + a :=
+sorry -- by simp
+
+theorem mul_bit1_helper [semiring A] (a b s t : A) (Hs : a * b = s) (Ht : bit0 s + a  = t) :
+        a * (bit1 b) = t :=
+sorry -- by simp
+
+theorem subst_into_prod [has_mul A] (l r tl tr t : A) (prl : l = tl) (prr : r = tr)
+        (prt : tl * tr = t) :
+        l * r = t :=
+sorry -- by simp
+
+theorem mk_cong (op : A → A) (a b : A) (H : a = b) : op a = op b :=
+sorry -- by simp
+
+theorem neg_add_neg_eq_of_add_add_eq_zero [add_comm_group A] (a b c : A) (H : c + a + b = 0) :
+        -a + -b = c :=
+sorry
+/-
+begin
+  apply add_neg_eq_of_eq_add,
+  apply neg_eq_of_add_eq_zero,
+  simp
+end
+-/
+
+theorem neg_add_neg_helper [add_comm_group A] (a b c : A) (H : a + b = c) : -a + -b = -c :=
+sorry -- begin apply iff.mp !neg_eq_neg_iff_eq, simp end
+
+theorem neg_add_pos_eq_of_eq_add [add_comm_group A] (a b c : A) (H : b = c + a) : -a + b = c :=
+sorry -- begin apply neg_add_eq_of_eq_add, simp end
+
+theorem neg_add_pos_helper1 [add_comm_group A] (a b c : A) (H : b + c = a) : -a + b = -c :=
+sorry -- begin apply neg_add_eq_of_eq_add, apply eq_add_neg_of_add_eq H end
+
+theorem neg_add_pos_helper2 [add_comm_group A] (a b c : A) (H : a + c = b) : -a + b = c :=
+sorry -- begin apply neg_add_eq_of_eq_add, rewrite H end
+
+theorem pos_add_neg_helper [add_comm_group A] (a b c : A) (H : b + a = c) : a + b = c :=
+sorry -- by simp
+
+theorem sub_eq_add_neg_helper [add_comm_group A] (t₁ t₂ e w₁ w₂: A) (H₁ : t₁ = w₁)
+        (H₂ : t₂ = w₂) (H : w₁ + -w₂ = e) : t₁ - t₂ = e :=
+sorry -- by simp
+
+theorem pos_add_pos_helper [add_comm_group A] (a b c h₁ h₂ : A) (H₁ : a = h₁) (H₂ : b = h₂)
+        (H : h₁ + h₂ = c) : a + b = c :=
+sorry -- by simp
+
+theorem subst_into_subtr [add_group A] (l r t : A) (prt : l + -r = t) : l - r = t :=
+sorry -- by simp
+
+theorem neg_neg_helper [add_group A] (a b : A) (H : a = -b) : -a = b :=
+sorry -- by simp
+
+theorem neg_mul_neg_helper [ring A] (a b c : A) (H : a * b = c) : (-a) * (-b) = c :=
+sorry -- by simp
+
+theorem neg_mul_pos_helper [ring A] (a b c : A) (H : a * b = c) : (-a) * b = -c :=
+sorry -- by simp
+
+theorem pos_mul_neg_helper [ring A] (a b c : A) (H : a * b = c) : a * (-b) = -c :=
+sorry -- by simp
+
+end norm_num
+
+attribute [simp]
+  zero_mul mul_zero
+
+attribute [simp]
+  neg_mul_eq_neg_mul_symm mul_neg_eq_neg_mul_symm
+
+attribute [simp]
+  left_distrib right_distrib

old_library/algebra/ring_bigops.lean

@@ -0,0 +1,183 @@
+/-
+Copyright (c) 2015 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+
+Properties of finite sums and products in various structures, including ordered rings and fields.
+There are two versions of every theorem: one for finsets, and one for finite sets.
+-/
+import .group_bigops .ordered_field
+
+variables {A B : Type}
+variable [deceqA : decidable_eq A]
+
+/-
+-- finset versions
+-/
+
+namespace finset
+
+section comm_semiring
+  variable [csB : comm_semiring B]
+  include deceqA csB
+
+  proposition mul_Sum (f : A → B) {s : finset A} (b : B) :
+    b * (∑ x ∈ s, f x) = ∑ x ∈ s, b * f x :=
+  begin
+    induction s with a s ans ih,
+      {rewrite [+Sum_empty, mul_zero]},
+    rewrite [Sum_insert_of_not_mem f ans, Sum_insert_of_not_mem (λ x, b * f x) ans],
+    rewrite [-ih, left_distrib]
+  end
+
+  proposition Sum_mul (f : A → B) {s : finset A} (b : B) :
+    (∑ x ∈ s, f x) * b = ∑ x ∈ s, f x * b :=
+  by rewrite [mul.comm _ b, mul_Sum]; apply Sum_ext; intros; apply mul.comm
+
+  proposition Prod_eq_zero (f : A → B) {s : finset A} {a : A} (H : a ∈ s) (fa0 : f a = 0) :
+    (∏ x ∈ s, f x) = 0 :=
+  begin
+    induction s with b s bns ih,
+      {exact absurd H !not_mem_empty},
+    rewrite [Prod_insert_of_not_mem f bns],
+    have a = b ∨ a ∈ s, from eq_or_mem_of_mem_insert H,
+    cases this with aeqb ains,
+      {rewrite [-aeqb, fa0, zero_mul]},
+    rewrite [ih ains, mul_zero]
+  end
+end comm_semiring
+
+section ordered_comm_group
+  variable [ocgB : ordered_comm_group B]
+  include deceqA ocgB
+
+  proposition Sum_le_Sum (f g : A → B) {s : finset A} (H: ∀ x, x ∈ s → f x ≤ g x) :
+    (∑ x ∈ s, f x) ≤ (∑ x ∈ s, g x) :=
+  begin
+    induction s with a s ans ih,
+      {exact le.refl _},
+    have H1 : f a ≤ g a, from H _ !mem_insert,
+    have H2 : (∑ x ∈ s, f x) ≤  (∑ x ∈ s, g x), from ih (forall_of_forall_insert H),
+    rewrite [Sum_insert_of_not_mem f ans, Sum_insert_of_not_mem g ans],
+    apply add_le_add H1 H2
+  end
+
+  proposition Sum_nonneg (f : A → B) {s : finset A} (H : ∀x, x ∈ s → f x ≥ 0) :
+    (∑ x ∈ s, f x) ≥ 0 :=
+  calc
+      0 = (∑ x ∈ s, 0)   : Sum_zero
+    ... ≤ (∑ x ∈ s, f x) : Sum_le_Sum (λ x, 0) f H
+
+  proposition Sum_nonpos (f : A → B) {s : finset A} (H : ∀x, x ∈ s → f x ≤ 0) :
+    (∑ x ∈ s, f x) ≤ 0 :=
+  calc
+      0 = (∑ x ∈ s, 0)   : Sum_zero
+    ... ≥ (∑ x ∈ s, f x) : Sum_le_Sum f (λ x, 0) H
+end ordered_comm_group
+
+section decidable_linear_ordered_comm_group
+  variable [dloocgB : decidable_linear_ordered_comm_group B]
+  include deceqA dloocgB
+
+  proposition abs_Sum_le (f : A → B) (s : finset A) : abs (∑ x ∈ s, f x) ≤ (∑ x ∈ s, abs (f x)) :=
+  begin
+    induction s with a s ans ih,
+      {rewrite [+Sum_empty, abs_zero]},
+    rewrite [Sum_insert_of_not_mem f ans, Sum_insert_of_not_mem _ ans],
+    apply le.trans,
+      apply abs_add_le_abs_add_abs,
+    apply add_le_add_left ih
+  end
+end decidable_linear_ordered_comm_group
+
+end finset
+
+/-
+-- set versions
+-/
+
+namespace set
+local attribute classical.prop_decidable [instance]
+
+section comm_semiring
+  variable [csB : comm_semiring B]
+  include csB
+
+  proposition mul_Sum (f : A → B) {s : set A} (b : B) :
+    b * (∑ x ∈ s, f x) = ∑ x ∈ s, b * f x :=
+  begin
+    cases (em (finite s)) with fins nfins,
+    rotate 1,
+      {rewrite [+Sum_of_not_finite nfins, mul_zero]},
+    induction fins with a s fins ans ih,
+      {rewrite [+Sum_empty, mul_zero]},
+    rewrite [Sum_insert_of_not_mem f ans, Sum_insert_of_not_mem (λ x, b * f x) ans],
+    rewrite [-ih, left_distrib]
+  end
+
+  proposition Sum_mul (f : A → B) {s : set A} (b : B) :
+    (∑ x ∈ s, f x) * b = ∑ x ∈ s, f x * b :=
+  by rewrite [mul.comm _ b, mul_Sum]; apply Sum_ext; intros; apply mul.comm
+
+  proposition Prod_eq_zero (f : A → B) {s : set A} [fins : finite s] {a : A} (H : a ∈ s) (fa0 : f a = 0) :
+    (∏ x ∈ s, f x) = 0 :=
+  begin
+    induction fins with b s fins bns ih,
+      {exact absurd H !not_mem_empty},
+    rewrite [Prod_insert_of_not_mem f bns],
+    have a = b ∨ a ∈ s, from eq_or_mem_of_mem_insert H,
+    cases this with aeqb ains,
+      {rewrite [-aeqb, fa0, zero_mul]},
+    rewrite [ih ains, mul_zero]
+  end
+end comm_semiring
+
+section ordered_comm_group
+  variable [ocgB : ordered_comm_group B]
+  include ocgB
+
+  proposition Sum_le_Sum (f g : A → B) {s : set A} (H: ∀₀ x ∈ s, f x ≤ g x) :
+    (∑ x ∈ s, f x) ≤ (∑ x ∈ s, g x) :=
+  begin
+    cases (em (finite s)) with fins nfins,
+     {induction fins with a s fins ans ih,
+       {rewrite +Sum_empty},
+       {rewrite [Sum_insert_of_not_mem f ans, Sum_insert_of_not_mem g ans],
+         have H1 : f a ≤ g a, from H !mem_insert,
+         have H2 : (∑ x ∈ s, f x) ≤ (∑ x ∈ s, g x), from ih (forall_of_forall_insert H),
+         apply add_le_add H1 H2}},
+    rewrite [+Sum_of_not_finite nfins]
+  end
+
+  proposition Sum_nonneg (f : A → B) {s : set A} (H : ∀₀ x ∈ s, f x ≥ 0) :
+    (∑ x ∈ s, f x) ≥ 0 :=
+  calc
+      0 = (∑ x ∈ s, 0)   : Sum_zero
+    ... ≤ (∑ x ∈ s, f x) : Sum_le_Sum (λ x, 0) f H
+
+  proposition Sum_nonpos (f : A → B) {s : set A} (H : ∀₀ x ∈ s, f x ≤ 0) :
+    (∑ x ∈ s, f x) ≤ 0 :=
+  calc
+      0 = (∑ x ∈ s, 0)   : Sum_zero
+    ... ≥ (∑ x ∈ s, f x) : Sum_le_Sum f (λ x, 0) H
+end ordered_comm_group
+
+section decidable_linear_ordered_comm_group
+  variable [dloocgB : decidable_linear_ordered_comm_group B]
+  include deceqA dloocgB
+
+  proposition abs_Sum_le (f : A → B) (s : set A) : abs (∑ x ∈ s, f x) ≤ (∑ x ∈ s, abs (f x)) :=
+  begin
+    cases (em (finite s)) with fins nfins,
+    rotate 1,
+      {rewrite [+Sum_of_not_finite nfins, abs_zero]},
+    induction fins with a s fins ans ih,
+      {rewrite [+Sum_empty, abs_zero]},
+    rewrite [Sum_insert_of_not_mem f ans, Sum_insert_of_not_mem _ ans],
+    apply le.trans,
+      apply abs_add_le_abs_add_abs,
+    apply add_le_add_left ih
+  end
+end decidable_linear_ordered_comm_group
+
+end set

old_library/algebra/ring_power.lean

@@ -0,0 +1,203 @@
+/-
+Copyright (c) 2015 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+
+Properties of the power operation in various structures, including ordered rings and fields.
+-/
+import .group_power .ordered_field
+open nat
+
+variable {A : Type}
+
+section semiring
+variable [s : semiring A]
+include s
+
+attribute [instance]
+definition semiring_has_pow_nat : has_pow_nat A :=
+monoid_has_pow_nat
+
+theorem zero_pow {m : ℕ} (mpos : m > 0) : 0^m = (0 : A) :=
+have h₁ : ∀ m : nat, (0 : A)^(succ m) = (0 : A),
+  begin
+    intro m, induction m,
+      krewrite pow_one,
+      apply zero_mul
+  end,
+obtain m' (h₂ : m = succ m'), from exists_eq_succ_of_pos mpos,
+show 0^m = 0, by rewrite h₂; apply h₁
+
+end semiring
+
+section integral_domain
+variable [s : integral_domain A]
+include s
+
+attribute [instance]
+definition integral_domain_has_pow_nat : has_pow_nat A :=
+monoid_has_pow_nat
+
+theorem eq_zero_of_pow_eq_zero {a : A} {m : ℕ} (H : a^m = 0) : a = 0 :=
+or.elim (eq_zero_or_pos m)
+  (suppose m = 0,
+    by rewrite [`m = 0` at H, pow_zero at H]; apply absurd H (ne.symm zero_ne_one))
+  (suppose m > 0,
+    have h₁ : ∀ m, a^succ m = 0 → a = 0,
+      begin
+        intro m,
+        induction m with m ih,
+          {krewrite pow_one; intros; assumption},
+        rewrite pow_succ,
+        intro H,
+        cases eq_zero_or_eq_zero_of_mul_eq_zero H with h₃ h₄,
+          assumption,
+        exact ih h₄
+      end,
+    obtain m' (h₂ : m = succ m'), from exists_eq_succ_of_pos `m > 0`,
+    show a = 0, by rewrite h₂ at H; apply h₁ m' H)
+
+theorem pow_ne_zero_of_ne_zero {a : A} {m : ℕ} (H : a ≠ 0) : a^m ≠ 0 :=
+assume H', H (eq_zero_of_pow_eq_zero H')
+
+end integral_domain
+
+section division_ring
+variable [s : division_ring A]
+include s
+
+theorem division_ring.pow_ne_zero_of_ne_zero {a : A} {m : ℕ} (H : a ≠ 0) : a^m ≠ 0 :=
+or.elim (eq_zero_or_pos m)
+  (suppose m = 0,
+    by rewrite [`m = 0`, pow_zero]; exact (ne.symm zero_ne_one))
+  (suppose m > 0,
+    have h₁ : ∀ m, a^succ m ≠ 0,
+      begin
+        intro m,
+        induction m with m ih,
+          { krewrite pow_one; assumption },
+        rewrite pow_succ,
+        apply division_ring.mul_ne_zero H ih
+      end,
+    obtain m' (h₂ : m = succ m'), from exists_eq_succ_of_pos `m > 0`,
+    show a^m ≠ 0, by rewrite h₂; apply h₁ m')
+
+end division_ring
+
+section linear_ordered_semiring
+variable [s : linear_ordered_semiring A]
+include s
+
+theorem pow_pos_of_pos {x : A} (i : ℕ) (H : x > 0) : x^i > 0 :=
+begin
+  induction i with [j, ih],
+    {show (1 : A) > 0, from zero_lt_one},
+    {show x^(succ j) > 0, from mul_pos H ih}
+end
+
+theorem pow_nonneg_of_nonneg {x : A} (i : ℕ) (H : x ≥ 0) : x^i ≥ 0 :=
+begin
+  induction i with j ih,
+    {show (1 : A) ≥ 0, from le_of_lt zero_lt_one},
+    {show x^(succ j) ≥ 0, from mul_nonneg H ih}
+end
+
+theorem pow_le_pow_of_le {x y : A} (i : ℕ) (H₁ : 0 ≤ x) (H₂ : x ≤ y) : x^i ≤ y^i :=
+begin
+  induction i with i ih,
+    {rewrite *pow_zero, apply le.refl},
+  rewrite *pow_succ,
+  have H : 0 ≤ x^i, from pow_nonneg_of_nonneg i H₁,
+  apply mul_le_mul H₂ ih H (le.trans H₁ H₂)
+end
+
+theorem pow_ge_one {x : A} (i : ℕ) (xge1 : x ≥ 1) : x^i ≥ 1 :=
+have H : x^i ≥ 1^i, from pow_le_pow_of_le i (le_of_lt zero_lt_one) xge1,
+by rewrite one_pow at H; exact H
+
+theorem pow_gt_one {x : A} {i : ℕ} (xgt1 : x > 1) (ipos : i > 0) : x^i > 1 :=
+have xpos : x > 0, from lt.trans zero_lt_one xgt1,
+begin
+  induction i with [i, ih],
+    {exfalso, exact !lt.irrefl ipos},
+  have xige1 : x^i ≥ 1, from pow_ge_one _ (le_of_lt xgt1),
+  rewrite [pow_succ, -mul_one 1],
+  apply mul_lt_mul xgt1 xige1 zero_lt_one,
+  apply le_of_lt xpos
+end
+
+theorem squared_lt_squared {x y : A} (H1 : 0 ≤ x) (H2 : x < y) : x^2 < y^2 :=
+by rewrite [*pow_two]; apply mul_self_lt_mul_self H1 H2
+
+theorem squared_le_squared {x y : A} (H1 : 0 ≤ x) (H2 : x ≤ y) : x^2 ≤ y^2 :=
+or.elim (lt_or_eq_of_le H2)
+  (assume xlty, le_of_lt (squared_lt_squared H1 xlty))
+  (assume xeqy, by rewrite xeqy; apply le.refl)
+
+theorem lt_of_squared_lt_squared {x y : A} (H1 : y ≥ 0) (H2 : x^2 < y^2) : x < y :=
+lt_of_not_ge (assume H : x ≥ y, not_le_of_gt H2 (squared_le_squared H1 H))
+
+theorem le_of_squared_le_squared {x y : A} (H1 : y ≥ 0) (H2 : x^2 ≤ y^2) : x ≤ y :=
+le_of_not_gt (assume H : x > y, not_lt_of_ge H2 (squared_lt_squared H1 H))
+
+theorem eq_of_squared_eq_squared_of_nonneg {x y : A} (H1 : x ≥ 0) (H2 : y ≥ 0) (H3 : x^2 = y^2) :
+  x = y :=
+lt.by_cases
+  (suppose x < y, absurd (eq.subst H3 (squared_lt_squared H1 this)) !lt.irrefl)
+  (suppose x = y, this)
+  (suppose x > y, absurd (eq.subst H3 (squared_lt_squared H2 this)) !lt.irrefl)
+
+end linear_ordered_semiring
+
+section decidable_linear_ordered_comm_ring
+variable [s : decidable_linear_ordered_comm_ring A]
+include s
+
+attribute [instance]
+definition decidable_linear_ordered_comm_ring_has_pow_nat : has_pow_nat A :=
+monoid_has_pow_nat
+
+theorem abs_pow (a : A) (n : ℕ) : abs (a^n) = abs a^n :=
+begin
+  induction n with n ih,
+    krewrite [*pow_zero, (abs_of_nonneg zero_le_one : abs (1 : A) = 1)],
+  rewrite [*pow_succ, abs_mul, ih]
+end
+
+theorem squared_nonneg (x : A) : x^2 ≥ 0 := by rewrite [pow_two]; apply mul_self_nonneg
+
+theorem eq_zero_of_squared_eq_zero {x : A} (H : x^2 = 0) : x = 0 :=
+by rewrite [pow_two at H]; exact eq_zero_of_mul_self_eq_zero H
+
+theorem abs_eq_abs_of_squared_eq_squared {x y : A} (H : x^2 = y^2) : abs x = abs y :=
+have (abs x)^2 = (abs y)^2, by rewrite [-+abs_pow, H],
+eq_of_squared_eq_squared_of_nonneg (abs_nonneg x) (abs_nonneg y) this
+
+end decidable_linear_ordered_comm_ring
+
+section field
+variable [s : field A]
+include s
+
+theorem field.div_pow (a : A) {b : A} {n : ℕ} (bnz : b ≠ 0) : (a / b)^n = a^n / b^n :=
+begin
+  induction n with n ih,
+    krewrite [*pow_zero, div_one],
+  have bnnz : b^n ≠ 0, from division_ring.pow_ne_zero_of_ne_zero bnz,
+  rewrite [*pow_succ, ih, !field.div_mul_div bnz bnnz]
+end
+
+end field
+
+section discrete_field
+variable [s : discrete_field A]
+include s
+
+theorem div_pow (a : A) {b : A} {n : ℕ} : (a / b)^n = a^n / b^n :=
+begin
+  induction n with n ih,
+    krewrite [*pow_zero, div_one],
+  rewrite [*pow_succ, ih, div_mul_div]
+end
+
+end discrete_field

old_library/data/bag.lean

@@ -0,0 +1,695 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+
+Finite bags.
+-/
+import data.nat data.list.perm algebra.binary
+open nat quot list subtype binary function eq.ops
+open [decl] perm
+
+variable {A : Type}
+
+attribute [instance]
+definition bag.setoid (A : Type) : setoid (list A) :=
+setoid.mk (@perm A) (mk_equivalence (@perm A) (@perm.refl A) (@perm.symm A) (@perm.trans A))
+
+definition bag (A : Type) : Type :=
+quot (bag.setoid A)
+
+namespace bag
+definition of_list (l : list A) : bag A :=
+⟦l⟧
+
+definition empty : bag A :=
+of_list nil
+
+definition singleton (a : A) : bag A :=
+of_list [a]
+
+definition insert (a : A) (b : bag A) : bag A :=
+quot.lift_on b (λ l, ⟦a::l⟧)
+  (λ l₁ l₂ h, quot.sound (perm.skip a h))
+
+lemma insert_empty_eq_singleton (a : A) : insert a empty = singleton a :=
+rfl
+
+definition insert.comm (a₁ a₂ : A) (b : bag A) : insert a₁ (insert a₂ b) = insert a₂ (insert a₁ b) :=
+quot.induction_on b (λ l, quot.sound !perm.swap)
+
+definition append (b₁ b₂ : bag A) : bag A :=
+quot.lift_on₂ b₁ b₂ (λ l₁ l₂, ⟦l₁++l₂⟧)
+  (λ l₁ l₂ l₃ l₄ h₁ h₂, quot.sound (perm_app h₁ h₂))
+
+infix ++ := append
+
+lemma append.comm (b₁ b₂ : bag A) : b₁ ++ b₂ = b₂ ++ b₁ :=
+quot.induction_on₂ b₁ b₂ (λ l₁ l₂, quot.sound !perm_app_comm)
+
+lemma append.assoc (b₁ b₂ b₃ : bag A) : (b₁ ++ b₂) ++ b₃ = b₁ ++ (b₂ ++ b₃) :=
+quot.induction_on₃ b₁ b₂ b₃ (λ l₁ l₂ l₃, quot.sound (by rewrite list.append.assoc; apply perm.refl))
+
+lemma append_empty_left (b : bag A) : empty ++ b = b :=
+quot.induction_on b (λ l, quot.sound (by rewrite append_nil_left; apply perm.refl))
+
+lemma append_empty_right (b : bag A) : b ++ empty = b :=
+quot.induction_on b (λ l, quot.sound (by rewrite append_nil_right; apply perm.refl))
+
+lemma append_insert_left (a : A) (b₁ b₂ : bag A) : insert a b₁ ++ b₂ = insert a (b₁ ++ b₂) :=
+quot.induction_on₂ b₁ b₂ (λ l₁ l₂, quot.sound (by rewrite append_cons; apply perm.refl))
+
+lemma append_insert_right (a : A) (b₁ b₂ : bag A) : b₁ ++ insert a b₂ = insert a (b₁ ++ b₂) :=
+calc b₁ ++ insert a b₂  = insert a b₂ ++ b₁   : append.comm
+                    ... = insert a (b₂ ++ b₁) : append_insert_left
+                    ... = insert a (b₁ ++ b₂) : append.comm
+
+attribute [recursor 3]
+protected lemma induction_on {C : bag A → Prop} (b : bag A) (h₁ : C empty) (h₂ : ∀ a b, C b → C (insert a b)) : C b :=
+quot.induction_on b (λ l, list.induction_on l h₁ (λ h t ih, h₂ h ⟦t⟧ ih))
+
+section decidable_eq
+variable [decA : decidable_eq A]
+include decA
+open decidable
+
+attribute [instance]
+definition has_decidable_eq (b₁ b₂ : bag A) : decidable (b₁ = b₂) :=
+quot.rec_on_subsingleton₂ b₁ b₂ (λ l₁ l₂,
+  match decidable_perm l₁ l₂ with
+  | inl h := inl (quot.sound h)
+  | inr h := inr (λ n, absurd (quot.exact n) h)
+  end)
+end decidable_eq
+
+section count
+variable [decA : decidable_eq A]
+include decA
+
+definition count (a : A) (b : bag A) : nat :=
+quot.lift_on b (λ l, count a l)
+  (λ l₁ l₂ h, count_eq_of_perm h a)
+
+lemma count_empty (a : A) : count a empty = 0 :=
+rfl
+
+lemma count_insert (a : A) (b : bag A) : count a (insert a b) = succ (count a b) :=
+quot.induction_on b (λ l, begin unfold [insert, count], rewrite count_cons_eq end)
+
+lemma count_insert_of_ne {a₁ a₂ : A} (h : a₁ ≠ a₂) (b : bag A) : count a₁ (insert a₂ b) = count a₁ b :=
+quot.induction_on b (λ l, begin unfold [insert, count], rewrite (count_cons_of_ne h) end)
+
+lemma count_singleton (a : A) : count a (singleton a) = 1 :=
+begin rewrite [-insert_empty_eq_singleton, count_insert] end
+
+lemma count_append (a : A) (b₁ b₂ : bag A) : count a (append b₁ b₂) = count a b₁ + count a b₂ :=
+quot.induction_on₂ b₁ b₂ (λ l₁ l₂, begin unfold [append, count], rewrite list.count_append end)
+
+open perm decidable
+protected lemma ext {b₁ b₂ : bag A} : (∀ a, count a b₁ = count a b₂) → b₁ = b₂ :=
+quot.induction_on₂ b₁ b₂ (λ l₁ l₂ (h : ∀ a, count a ⟦l₁⟧ = count a ⟦l₂⟧),
+ have gen : ∀ (l₁ l₂ : list A), (∀ a, list.count a l₁ = list.count a l₂) → l₁ ~ l₂
+ | []       []       h₁ := !perm.refl
+ | []       (a₂::s₂) h₁ := have list.count a₂ [] = list.count a₂ (a₂::s₂), from h₁ a₂, by rewrite [count_nil at this, count_cons_eq at this]; contradiction
+ | (a::s₁) s₂       h₁ :=
+   have g₁ : list.count a (a::s₁) > 0, from count_gt_zero_of_mem !mem_cons,
+   have list.count a (a::s₁) = list.count a s₂, from h₁ a,
+   have list.count a s₂ > 0, by rewrite [-this]; exact g₁,
+   have a ∈ s₂,                from mem_of_count_gt_zero this,
+   have ∃ l r, s₂ = l++(a::r), from mem_split this,
+   obtain l r (e₁ : s₂ = l++(a::r)), from this,
+   have ∀ a, list.count a s₁ = list.count a (l++r), from
+     take a₁,
+     have e₂ : list.count a₁ (a::s₁) = list.count a₁ (l++(a::r)), by rewrite -e₁; exact h₁ a₁,
+     by_cases
+       (suppose a₁ = a, begin
+          rewrite [-this at e₂, list.count_append at e₂, *count_cons_eq at e₂, add_succ at e₂],
+          injection e₂ with e₃, rewrite e₃,
+          rewrite list.count_append
+        end)
+       (suppose a₁ ≠ a,
+        by rewrite [list.count_append at e₂, *count_cons_of_ne this at e₂, e₂, list.count_append]),
+   have ih : s₁ ~ l++r,             from gen s₁ (l++r) this,
+   calc a::s₁ ~ a::(l++r) : perm.skip a ih
+         ...  ~ l++(a::r) : perm_middle
+         ...  = s₂        : e₁,
+ quot.sound (gen l₁ l₂ h))
+
+definition insert.inj {a : A} {b₁ b₂ : bag A} : insert a b₁ = insert a b₂ → b₁ = b₂ :=
+assume h, bag.ext (take x,
+  have e : count x (insert a b₁) = count x (insert a b₂), by rewrite h,
+  by_cases
+    (suppose x = a, begin subst x, rewrite [*count_insert at e], injection e, assumption end)
+    (suppose x ≠ a, begin rewrite [*count_insert_of_ne this at e], assumption end))
+end count
+
+section extract
+open decidable
+variable [decA : decidable_eq A]
+include decA
+
+definition extract (a : A) (b : bag A) : bag A :=
+quot.lift_on b (λ l, ⟦filter (λ c, c ≠ a) l⟧)
+  (λ l₁ l₂ h, quot.sound (perm_filter h))
+
+lemma extract_singleton (a : A) : extract a (singleton a) = empty :=
+begin unfold [extract, singleton, of_list, filter], rewrite [if_neg (λ h : a ≠ a, absurd rfl h)] end
+
+lemma extract_insert (a : A) (b : bag A) : extract a (insert a b) = extract a b :=
+quot.induction_on b (λ l, begin
+  unfold [insert, extract],
+  rewrite [@filter_cons_of_neg _ (λ c, c ≠ a) _ _ l (not_not_intro (eq.refl a))]
+end)
+
+lemma extract_insert_of_ne {a₁ a₂ : A} (h : a₁ ≠ a₂) (b : bag A) : extract a₁ (insert a₂ b) = insert a₂ (extract a₁ b) :=
+quot.induction_on b (λ l, begin
+  unfold [insert, extract],
+  rewrite [@filter_cons_of_pos _ (λ c, c ≠ a₁) _ _ l (ne.symm h)]
+end)
+
+lemma count_extract (a : A) (b : bag A) : count a (extract a b) = 0 :=
+bag.induction_on b rfl
+  (λ c b ih, by_cases
+     (suppose a = c, begin subst c, rewrite [extract_insert, ih] end)
+     (suppose a ≠ c, begin rewrite [extract_insert_of_ne this, count_insert_of_ne this, ih] end))
+
+lemma count_extract_of_ne {a₁ a₂ : A} (h : a₁ ≠ a₂) (b : bag A) : count a₁ (extract a₂ b) = count a₁ b :=
+bag.induction_on b rfl
+  (take x b ih, by_cases
+    (suppose x = a₁, begin subst x, rewrite [extract_insert_of_ne (ne.symm h), *count_insert, ih] end)
+    (suppose x ≠ a₁, by_cases
+      (suppose x = a₂, begin subst x, rewrite [extract_insert, ih, count_insert_of_ne h] end)
+      (suppose x ≠ a₂, begin
+        rewrite [count_insert_of_ne (ne.symm `x ≠ a₁`), extract_insert_of_ne (ne.symm this)],
+        rewrite [count_insert_of_ne (ne.symm `x ≠ a₁`), ih]
+       end)))
+end extract
+
+section erase
+variable [decA : decidable_eq A]
+include decA
+
+definition erase (a : A) (b : bag A) : bag A :=
+quot.lift_on b (λ l, ⟦erase a l⟧)
+  (λ l₁ l₂ h, quot.sound (erase_perm_erase_of_perm _ h))
+
+lemma erase_empty (a : A) : erase a empty = empty :=
+rfl
+
+lemma erase_insert (a : A) (b : bag A) : erase a (insert a b) = b :=
+quot.induction_on b (λ l, quot.sound (by rewrite erase_cons_head; apply perm.refl))
+
+lemma erase_insert_of_ne {a₁ a₂ : A} (h : a₁ ≠ a₂) (b : bag A) : erase a₁ (insert a₂ b) = insert a₂ (erase a₁ b) :=
+quot.induction_on b (λ l, quot.sound (by rewrite (erase_cons_tail _ h); apply perm.refl))
+
+end erase
+
+section member
+variable [decA : decidable_eq A]
+include decA
+
+definition mem (a : A) (b : bag A) := count a b > 0
+infix ∈ := mem
+
+lemma mem_def (a : A) (b : bag A) : (a ∈ b) = (count a b > 0) :=
+rfl
+
+lemma mem_insert (a : A) (b : bag A) : a ∈ insert a b :=
+begin unfold mem, rewrite count_insert, exact dec_trivial end
+
+lemma mem_of_list_iff_mem (a : A) (l : list A) : a ∈ of_list l ↔ a ∈ l :=
+iff.intro !mem_of_count_gt_zero !count_gt_zero_of_mem
+
+lemma count_of_list_eq_count (a : A) (l : list A) : count a (of_list l) = list.count a l :=
+rfl
+end member
+
+section union_inter
+variable [decA : decidable_eq A]
+include decA
+open perm decidable
+
+private definition union_list (l₁ l₂ : list A) :=
+erase_dup (l₁ ++ l₂)
+
+private lemma perm_union_list {l₁ l₂ l₃ l₄ : list A} (h₁ : l₁ ~ l₃) (h₂ : l₂ ~ l₄) : union_list l₁ l₂ ~ union_list l₃ l₄ :=
+perm_erase_dup_of_perm (perm_app h₁ h₂)
+
+private lemma nodup_union_list (l₁ l₂ : list A) : nodup (union_list l₁ l₂) :=
+!nodup_erase_dup
+
+private definition not_mem_of_not_mem_union_list_left {a : A} {l₁ l₂ : list A} (h : a ∉ union_list l₁ l₂) : a ∉ l₁ :=
+suppose a ∈ l₁,
+have a ∈ l₁ ++ l₂, from mem_append_left _ this,
+have a ∈ erase_dup (l₁ ++ l₂), from mem_erase_dup this,
+absurd this h
+
+private definition not_mem_of_not_mem_union_list_right {a : A} {l₁ l₂ : list A} (h : a ∉ union_list l₁ l₂) : a ∉ l₂ :=
+suppose a ∈ l₂,
+have a ∈ l₁ ++ l₂, from mem_append_right _ this,
+have a ∈ erase_dup (l₁ ++ l₂), from mem_erase_dup this,
+absurd this h
+
+private definition gen : nat → A → list A
+| 0     a := nil
+| (n+1) a := a :: gen n a
+
+private lemma not_mem_gen_of_ne {a b : A} (h : a ≠ b) : ∀ n, a ∉ gen n b
+| 0     := !not_mem_nil
+| (n+1) := not_mem_cons_of_ne_of_not_mem h (not_mem_gen_of_ne n)
+
+private lemma count_gen : ∀ (a : A) (n : nat), list.count a (gen n a) = n
+| a 0     := rfl
+| a (n+1) := begin unfold gen, rewrite [count_cons_eq, count_gen] end
+
+private lemma count_gen_eq_zero_of_ne {a b : A} (h : a ≠ b) : ∀ n, list.count a (gen n b) = 0
+| 0     := rfl
+| (n+1) := begin unfold gen, rewrite [count_cons_of_ne h, count_gen_eq_zero_of_ne] end
+
+private definition max_count (l₁ l₂ : list A) : list A → list A
+| []     := []
+| (a::l) := if list.count a l₁ ≥ list.count a l₂ then gen (list.count a l₁) a ++ max_count l else gen (list.count a l₂) a ++ max_count l
+
+private definition min_count (l₁ l₂ : list A) : list A → list A
+| []     := []
+| (a::l) := if list.count a l₁ ≤ list.count a l₂ then gen (list.count a l₁) a ++ min_count l else gen (list.count a l₂) a ++ min_count l
+
+private lemma not_mem_max_count_of_not_mem (l₁ l₂ : list A) : ∀ {a l}, a ∉ l → a ∉ max_count l₁ l₂ l
+| a []     h := !not_mem_nil
+| a (b::l) h :=
+  have ih : a ∉ max_count l₁ l₂ l, from not_mem_max_count_of_not_mem (not_mem_of_not_mem_cons h),
+  have a ≠ b, from ne_of_not_mem_cons h,
+  by_cases
+    (suppose list.count b l₁ ≥ list.count b l₂, begin
+      unfold max_count, rewrite [if_pos this],
+      exact not_mem_append (not_mem_gen_of_ne `a ≠ b` _) ih
+     end)
+    (suppose ¬ list.count b l₁ ≥ list.count b l₂, begin
+      unfold max_count, rewrite [if_neg this],
+      exact not_mem_append (not_mem_gen_of_ne `a ≠ b` _) ih
+     end)
+
+private lemma max_count_eq (l₁ l₂ : list A) : ∀ {a : A} {l : list A}, a ∈ l → nodup l → list.count a (max_count l₁ l₂ l) = max (list.count a l₁) (list.count a l₂)
+| a []     h₁ h₂ := absurd h₁ !not_mem_nil
+| a (b::l) h₁ h₂ :=
+  have nodup l, from nodup_of_nodup_cons h₂,
+  have b ∉ l,   from not_mem_of_nodup_cons h₂,
+  or.elim (eq_or_mem_of_mem_cons h₁)
+  (suppose a = b,
+    have a ∉ l, by rewrite this; assumption,
+    have a ∉ max_count l₁ l₂ l, from not_mem_max_count_of_not_mem l₁ l₂ this,
+    by_cases
+    (suppose i : list.count a l₁ ≥ list.count a l₂, begin
+       unfold max_count, subst b,
+       rewrite [if_pos i, list.count_append, count_gen, max_eq_left i, count_eq_zero_of_not_mem `a ∉ max_count l₁ l₂ l`]
+     end)
+    (suppose i : ¬ list.count a l₁ ≥ list.count a l₂, begin
+       unfold max_count, subst b,
+       rewrite [if_neg i, list.count_append, count_gen, max_eq_right_of_lt (lt_of_not_ge i), count_eq_zero_of_not_mem `a ∉ max_count l₁ l₂ l`]
+     end))
+  (suppose a ∈ l,
+    have a ≠ b, from suppose a = b, begin subst b, contradiction end,
+    have ih : list.count a (max_count l₁ l₂ l) = max (list.count a l₁) (list.count a l₂), from
+       max_count_eq `a ∈ l` `nodup l`,
+    by_cases
+    (suppose i : list.count b l₁ ≥ list.count b l₂, begin
+       unfold max_count,
+       rewrite [if_pos i, -ih, list.count_append, count_gen_eq_zero_of_ne `a ≠ b`, zero_add]
+     end)
+    (suppose i : ¬ list.count b l₁ ≥ list.count b l₂, begin
+       unfold max_count,
+       rewrite [if_neg i, -ih, list.count_append, count_gen_eq_zero_of_ne `a ≠ b`, zero_add]
+     end))
+
+private lemma not_mem_min_count_of_not_mem (l₁ l₂ : list A) : ∀ {a l}, a ∉ l → a ∉ min_count l₁ l₂ l
+| a []     h := !not_mem_nil
+| a (b::l) h :=
+  have ih : a ∉ min_count l₁ l₂ l, from not_mem_min_count_of_not_mem (not_mem_of_not_mem_cons h),
+  have a ≠ b, from ne_of_not_mem_cons h,
+  by_cases
+    (suppose list.count b l₁ ≤ list.count b l₂, begin
+      unfold min_count, rewrite [if_pos this],
+      exact not_mem_append (not_mem_gen_of_ne `a ≠ b` _) ih
+     end)
+    (suppose ¬ list.count b l₁ ≤ list.count b l₂, begin
+      unfold min_count, rewrite [if_neg this],
+      exact not_mem_append (not_mem_gen_of_ne `a ≠ b` _) ih
+     end)
+
+private lemma min_count_eq (l₁ l₂ : list A) : ∀ {a : A} {l : list A}, a ∈ l → nodup l → list.count a (min_count l₁ l₂ l) = min (list.count a l₁) (list.count a l₂)
+| a []     h₁ h₂ := absurd h₁ !not_mem_nil
+| a (b::l) h₁ h₂ :=
+  have nodup l, from nodup_of_nodup_cons h₂,
+  have b ∉ l,   from not_mem_of_nodup_cons h₂,
+  or.elim (eq_or_mem_of_mem_cons h₁)
+  (suppose a = b,
+    have a ∉ l, by rewrite this; assumption,
+    have a ∉ min_count l₁ l₂ l, from not_mem_min_count_of_not_mem l₁ l₂ this,
+    by_cases
+    (suppose i : list.count a l₁ ≤ list.count a l₂, begin
+       unfold min_count, subst b,
+       rewrite [if_pos i, list.count_append, count_gen, min_eq_left i, count_eq_zero_of_not_mem `a ∉ min_count l₁ l₂ l`]
+     end)
+    (suppose i : ¬ list.count a l₁ ≤ list.count a l₂, begin
+       unfold min_count, subst b,
+       rewrite [if_neg i, list.count_append, count_gen, min_eq_right (le_of_lt (lt_of_not_ge i)), count_eq_zero_of_not_mem `a ∉ min_count l₁ l₂ l`]
+     end))
+  (suppose a ∈ l,
+    have a ≠ b, from suppose a = b, by subst b; contradiction,
+    have ih : list.count a (min_count l₁ l₂ l) = min (list.count a l₁) (list.count a l₂), from min_count_eq `a ∈ l` `nodup l`,
+    by_cases
+    (suppose i : list.count b l₁ ≤ list.count b l₂, begin
+       unfold min_count,
+       rewrite [if_pos i, -ih, list.count_append, count_gen_eq_zero_of_ne `a ≠ b`, zero_add]
+     end)
+    (suppose i : ¬ list.count b l₁ ≤ list.count b l₂, begin
+       unfold min_count,
+       rewrite [if_neg i, -ih, list.count_append, count_gen_eq_zero_of_ne `a ≠ b`, zero_add]
+     end))
+
+private lemma perm_max_count_left {l₁ l₂ l₃ l₄ : list A} (h₁ : l₁ ~ l₃) (h₂ : l₂ ~ l₄) : ∀ l, max_count l₁ l₂ l ~ max_count l₃ l₄ l
+| []     := by esimp
+| (a::l) :=
+  have e₁ : list.count a l₁ = list.count a l₃, from count_eq_of_perm h₁ a,
+  have e₂ : list.count a l₂ = list.count a l₄, from count_eq_of_perm h₂ a,
+  by_cases
+    (suppose list.count a l₁ ≥ list.count a l₂,
+     begin unfold max_count, rewrite [-e₁, -e₂, *if_pos this], exact perm_app !perm.refl !perm_max_count_left end)
+    (suppose ¬ list.count a l₁ ≥ list.count a l₂,
+     begin unfold max_count, rewrite [-e₁, -e₂, *if_neg this], exact perm_app !perm.refl !perm_max_count_left end)
+
+private lemma perm_app_left_comm (l₁ l₂ l₃ : list A) : l₁ ++ (l₂ ++ l₃) ~ l₂ ++ (l₁ ++ l₃) :=
+calc l₁ ++ (l₂ ++ l₃) = (l₁ ++ l₂) ++ l₃ : list.append.assoc
+                ...   ~ (l₂ ++ l₁) ++ l₃ : perm_app !perm_app_comm !perm.refl
+                ...   = l₂ ++ (l₁ ++ l₃) : list.append.assoc
+
+private lemma perm_max_count_right {l r : list A} (h : l ~ r) : ∀ l₁ l₂, max_count l₁ l₂ l ~ max_count l₁ l₂ r :=
+perm.induction_on h
+  (λ l₁ l₂, !perm.refl)
+  (λ x s₁ s₂ p ih l₁ l₂, by_cases
+    (suppose i : list.count x l₁ ≥ list.count x l₂,
+      begin unfold max_count, rewrite [*if_pos i], exact perm_app !perm.refl !ih end)
+    (suppose i : ¬ list.count x l₁ ≥ list.count x l₂,
+      begin unfold max_count, rewrite [*if_neg i], exact perm_app !perm.refl !ih end))
+  (λ x y l l₁ l₂, by_cases
+    (suppose i₁ : list.count x l₁ ≥ list.count x l₂, by_cases
+      (suppose i₂ : list.count y l₁ ≥ list.count y l₂,
+        begin unfold max_count, unfold max_count, rewrite [*if_pos i₁, *if_pos i₂], apply perm_app_left_comm end)
+      (suppose i₂ : ¬ list.count y l₁ ≥ list.count y l₂,
+        begin unfold max_count, unfold max_count, rewrite [*if_pos i₁, *if_neg i₂], apply perm_app_left_comm end))
+    (suppose i₁ : ¬ list.count x l₁ ≥ list.count x l₂, by_cases
+      (suppose i₂ : list.count y l₁ ≥ list.count y l₂,
+        begin unfold max_count, unfold max_count, rewrite [*if_neg i₁, *if_pos i₂], apply perm_app_left_comm end)
+      (suppose i₂ : ¬ list.count y l₁ ≥ list.count y l₂,
+        begin unfold max_count, unfold max_count, rewrite [*if_neg i₁, *if_neg i₂], apply perm_app_left_comm end)))
+  (λ s₁ s₂ s₃ p₁ p₂ ih₁ ih₂ l₁ l₂, perm.trans (ih₁ l₁ l₂) (ih₂ l₁ l₂))
+
+private lemma perm_max_count {l₁ l₂ l₃ r₁ r₂ r₃ : list A} (p₁ : l₁ ~ r₁) (p₂ : l₂ ~ r₂) (p₃ : l₃ ~ r₃) : max_count l₁ l₂ l₃ ~ max_count r₁ r₂ r₃ :=
+calc max_count l₁ l₂ l₃ ~ max_count r₁ r₂ l₃ : perm_max_count_left p₁ p₂
+                    ... ~ max_count r₁ r₂ r₃ : perm_max_count_right p₃
+
+private lemma perm_min_count_left {l₁ l₂ l₃ l₄ : list A} (h₁ : l₁ ~ l₃) (h₂ : l₂ ~ l₄) : ∀ l, min_count l₁ l₂ l ~ min_count l₃ l₄ l
+| []     := by esimp
+| (a::l) :=
+  have e₁ : list.count a l₁ = list.count a l₃, from count_eq_of_perm h₁ a,
+  have e₂ : list.count a l₂ = list.count a l₄, from count_eq_of_perm h₂ a,
+  by_cases
+    (suppose list.count a l₁ ≤ list.count a l₂,
+     begin unfold min_count, rewrite [-e₁, -e₂, *if_pos this], exact perm_app !perm.refl !perm_min_count_left end)
+    (suppose ¬ list.count a l₁ ≤ list.count a l₂,
+     begin unfold min_count, rewrite [-e₁, -e₂, *if_neg this], exact perm_app !perm.refl !perm_min_count_left end)
+
+private lemma perm_min_count_right {l r : list A} (h : l ~ r) : ∀ l₁ l₂, min_count l₁ l₂ l ~ min_count l₁ l₂ r :=
+perm.induction_on h
+  (λ l₁ l₂, !perm.refl)
+  (λ x s₁ s₂ p ih l₁ l₂, by_cases
+    (suppose i : list.count x l₁ ≤ list.count x l₂,
+      begin unfold min_count, rewrite [*if_pos i], exact perm_app !perm.refl !ih end)
+    (suppose i : ¬ list.count x l₁ ≤ list.count x l₂,
+      begin unfold min_count, rewrite [*if_neg i], exact perm_app !perm.refl !ih end))
+  (λ x y l l₁ l₂, by_cases
+    (suppose i₁ : list.count x l₁ ≤ list.count x l₂, by_cases
+      (suppose i₂ : list.count y l₁ ≤ list.count y l₂,
+        begin unfold min_count, unfold min_count, rewrite [*if_pos i₁, *if_pos i₂], apply perm_app_left_comm end)
+      (suppose i₂ : ¬ list.count y l₁ ≤ list.count y l₂,
+        begin unfold min_count, unfold min_count, rewrite [*if_pos i₁, *if_neg i₂], apply perm_app_left_comm end))
+    (suppose i₁ : ¬ list.count x l₁ ≤ list.count x l₂, by_cases
+      (suppose i₂ : list.count y l₁ ≤ list.count y l₂,
+        begin unfold min_count, unfold min_count, rewrite [*if_neg i₁, *if_pos i₂], apply perm_app_left_comm end)
+      (suppose i₂ : ¬ list.count y l₁ ≤ list.count y l₂,
+        begin unfold min_count, unfold min_count, rewrite [*if_neg i₁, *if_neg i₂], apply perm_app_left_comm end)))
+  (λ s₁ s₂ s₃ p₁ p₂ ih₁ ih₂ l₁ l₂, perm.trans (ih₁ l₁ l₂) (ih₂ l₁ l₂))
+
+private lemma perm_min_count {l₁ l₂ l₃ r₁ r₂ r₃ : list A} (p₁ : l₁ ~ r₁) (p₂ : l₂ ~ r₂) (p₃ : l₃ ~ r₃) : min_count l₁ l₂ l₃ ~ min_count r₁ r₂ r₃ :=
+calc min_count l₁ l₂ l₃ ~ min_count r₁ r₂ l₃ : perm_min_count_left p₁ p₂
+                    ... ~ min_count r₁ r₂ r₃ : perm_min_count_right p₃
+
+definition union (b₁ b₂ : bag A) : bag A :=
+quot.lift_on₂ b₁ b₂ (λ l₁ l₂, ⟦max_count l₁ l₂ (union_list l₁ l₂)⟧)
+  (λ l₁ l₂ l₃ l₄ p₁ p₂, quot.sound (perm_max_count p₁ p₂ (perm_union_list p₁ p₂)))
+infix ∪ := union
+
+definition inter (b₁ b₂ : bag A) : bag A :=
+quot.lift_on₂ b₁ b₂ (λ l₁ l₂, ⟦min_count l₁ l₂ (union_list l₁ l₂)⟧)
+  (λ l₁ l₂ l₃ l₄ p₁ p₂, quot.sound (perm_min_count p₁ p₂ (perm_union_list p₁ p₂)))
+infix ∩ := inter
+
+lemma count_union (a : A) (b₁ b₂ : bag A) : count a (b₁ ∪ b₂) = max (count a b₁) (count a b₂) :=
+quot.induction_on₂ b₁ b₂ (λ l₁ l₂, by_cases
+  (suppose a ∈ union_list l₁ l₂, !max_count_eq this !nodup_union_list)
+  (suppose ¬ a ∈ union_list l₁ l₂,
+    have ¬ a ∈ l₁, from not_mem_of_not_mem_union_list_left `¬ a ∈ union_list l₁ l₂`,
+    have ¬ a ∈ l₂, from not_mem_of_not_mem_union_list_right `¬ a ∈ union_list l₁ l₂`,
+    have n : ¬ a ∈ max_count l₁ l₂ (union_list l₁ l₂), from not_mem_max_count_of_not_mem l₁ l₂ `¬ a ∈ union_list l₁ l₂`,
+    begin
+      unfold [union, count],
+      rewrite [count_eq_zero_of_not_mem `¬ a ∈ l₁`, count_eq_zero_of_not_mem `¬ a ∈ l₂`, max_self],
+      rewrite [count_eq_zero_of_not_mem n]
+    end))
+
+lemma count_inter (a : A) (b₁ b₂ : bag A) : count a (b₁ ∩ b₂) = min (count a b₁) (count a b₂) :=
+quot.induction_on₂ b₁ b₂ (λ l₁ l₂, by_cases
+  (suppose a ∈ union_list l₁ l₂, !min_count_eq this !nodup_union_list)
+  (suppose ¬ a ∈ union_list l₁ l₂,
+    have ¬ a ∈ l₁, from not_mem_of_not_mem_union_list_left `¬ a ∈ union_list l₁ l₂`,
+    have ¬ a ∈ l₂, from not_mem_of_not_mem_union_list_right `¬ a ∈ union_list l₁ l₂`,
+    have n : ¬ a ∈ min_count l₁ l₂ (union_list l₁ l₂), from not_mem_min_count_of_not_mem l₁ l₂ `¬ a ∈ union_list l₁ l₂`,
+    begin
+      unfold [inter, count],
+      rewrite [count_eq_zero_of_not_mem `¬ a ∈ l₁`, count_eq_zero_of_not_mem `¬ a ∈ l₂`, min_self],
+      rewrite [count_eq_zero_of_not_mem n]
+    end))
+
+lemma union_comm (b₁ b₂ : bag A) : b₁ ∪ b₂ = b₂ ∪ b₁ :=
+bag.ext (λ a, by rewrite [*count_union, max.comm])
+
+lemma union_assoc (b₁ b₂ b₃ : bag A) : (b₁ ∪ b₂) ∪ b₃ = b₁ ∪ (b₂ ∪ b₃) :=
+bag.ext (λ a, by rewrite [*count_union, max.assoc])
+
+theorem union_left_comm (s₁ s₂ s₃ : bag A) : s₁ ∪ (s₂ ∪ s₃) = s₂ ∪ (s₁ ∪ s₃) :=
+!left_comm union_comm union_assoc s₁ s₂ s₃
+
+lemma union_self (b : bag A) : b ∪ b = b :=
+bag.ext (λ a, by rewrite [*count_union, max_self])
+
+lemma union_empty (b : bag A) : b ∪ empty = b :=
+bag.ext (λ a, by rewrite [*count_union, count_empty, max_zero])
+
+lemma empty_union (b : bag A) : empty ∪ b = b :=
+calc empty ∪ b = b ∪ empty : union_comm
+           ... = b         : union_empty
+
+lemma inter_comm (b₁ b₂ : bag A) : b₁ ∩ b₂ = b₂ ∩ b₁ :=
+bag.ext (λ a, by rewrite [*count_inter, min.comm])
+
+lemma inter_assoc (b₁ b₂ b₃ : bag A) : (b₁ ∩ b₂) ∩ b₃ = b₁ ∩ (b₂ ∩ b₃) :=
+bag.ext (λ a, by rewrite [*count_inter, min.assoc])
+
+theorem inter_left_comm (s₁ s₂ s₃ : bag A) : s₁ ∩ (s₂ ∩ s₃) = s₂ ∩ (s₁ ∩ s₃) :=
+!left_comm inter_comm inter_assoc s₁ s₂ s₃
+
+lemma inter_self (b : bag A) : b ∩ b = b :=
+bag.ext (λ a, by rewrite [*count_inter, min_self])
+
+lemma inter_empty (b : bag A) : b ∩ empty = empty :=
+bag.ext (λ a, by rewrite [*count_inter, count_empty, min_zero])
+
+lemma empty_inter (b : bag A) : empty ∩ b = empty :=
+calc empty ∩ b = b ∩ empty : inter_comm
+           ... = empty     : inter_empty
+
+lemma append_union_inter (b₁ b₂ : bag A) : (b₁ ∪ b₂) ++ (b₁ ∩ b₂) = b₁ ++ b₂ :=
+bag.ext (λ a, begin
+  rewrite [*count_append, count_inter, count_union],
+  apply (or.elim (lt_or_ge (count a b₁) (count a b₂))),
+  { intro H, rewrite [min_eq_left_of_lt H, max_eq_right_of_lt H, add.comm] },
+  { intro H, rewrite [min_eq_right H, max_eq_left H, add.comm] }
+end)
+
+lemma inter_left_distrib (b₁ b₂ b₃ : bag A) : b₁ ∩ (b₂ ∪ b₃) = (b₁ ∩ b₂) ∪ (b₁ ∩ b₃) :=
+bag.ext (λ a, begin
+  rewrite [*count_inter, *count_union, *count_inter],
+  apply (@by_cases (count a b₁ ≤ count a b₂)),
+  { intro H₁₂, apply (@by_cases (count a b₂ ≤ count a b₃)),
+    { intro H₂₃,
+      have H₁₃ : count a b₁ ≤ count a b₃, from le.trans H₁₂ H₂₃,
+      rewrite [max_eq_right H₂₃, min_eq_left H₁₂, min_eq_left H₁₃, max_self]},
+    { intro H₂₃,
+      rewrite [min_eq_left H₁₂, max.comm, max_eq_right_of_lt (lt_of_not_ge H₂₃) ],
+      apply (@by_cases (count a b₁ ≤ count a b₃)),
+      { intro H₁₃, rewrite [min_eq_left H₁₃, max_self, min_eq_left H₁₂] },
+      { intro H₁₃,
+        rewrite [min.comm (count a b₁) (count a b₃), min_eq_left_of_lt (lt_of_not_ge H₁₃),
+                 min_eq_left H₁₂, max.comm, max_eq_right_of_lt (lt_of_not_ge H₁₃)]}}},
+  { intro H₁₂, apply (@by_cases (count a b₂ ≤ count a b₃)),
+    { intro H₂₃,
+      rewrite [max_eq_right H₂₃],
+      apply (@by_cases (count a b₁ ≤ count a b₃)),
+      { intro H₁₃, rewrite [min_eq_left H₁₃, min.comm, min_eq_left_of_lt (lt_of_not_ge H₁₂), max_eq_right_of_lt (lt_of_not_ge H₁₂)] },
+      { intro H₁₃, rewrite [min.comm, min_eq_left_of_lt (lt_of_not_ge H₁₃), min.comm, min_eq_left_of_lt (lt_of_not_ge H₁₂), max_eq_right H₂₃] } },
+    { intro H₂₃,
+      have H₁₃ : count a b₁ > count a b₃, from lt.trans (lt_of_not_ge H₂₃) (lt_of_not_ge H₁₂),
+      rewrite [max.comm, max_eq_right_of_lt (lt_of_not_ge H₂₃), min.comm, min_eq_left_of_lt (lt_of_not_ge H₁₂)],
+      rewrite [min.comm, min_eq_left_of_lt H₁₃, max.comm, max_eq_right_of_lt (lt_of_not_ge H₂₃)] } }
+end)
+
+lemma inter_right_distrib (b₁ b₂ b₃ : bag A) : (b₁ ∪ b₂) ∩ b₃ = (b₁ ∩ b₃) ∪ (b₂ ∩ b₃) :=
+calc (b₁ ∪ b₂) ∩ b₃ = b₃ ∩ (b₁ ∪ b₂)        : inter_comm
+              ...   = (b₃ ∩ b₁) ∪ (b₃ ∩ b₂) : inter_left_distrib
+              ...   = (b₁ ∩ b₃) ∪ (b₃ ∩ b₂) : inter_comm
+              ...   = (b₁ ∩ b₃) ∪ (b₂ ∩ b₃) : inter_comm
+end union_inter
+
+section subbag
+variable [decA : decidable_eq A]
+include decA
+
+definition subbag (b₁ b₂ : bag A) := ∀ a, count a b₁ ≤ count a b₂
+
+infix ⊆ := subbag
+
+lemma subbag.refl (b : bag A) : b ⊆ b :=
+take a, !le.refl
+
+lemma subbag.trans {b₁ b₂ b₃ : bag A} : b₁ ⊆ b₂ → b₂ ⊆ b₃ → b₁ ⊆ b₃ :=
+assume h₁ h₂, take a, le.trans (h₁ a) (h₂ a)
+
+lemma subbag.antisymm {b₁ b₂ : bag A} : b₁ ⊆ b₂ → b₂ ⊆ b₁ → b₁ = b₂ :=
+assume h₁ h₂, bag.ext (take a, le.antisymm (h₁ a) (h₂ a))
+
+lemma count_le_of_subbag {b₁ b₂ : bag A} : b₁ ⊆ b₂ → ∀ a, count a b₁ ≤ count a b₂ :=
+assume h, h
+
+lemma subbag.intro {b₁ b₂ : bag A} : (∀ a, count a b₁ ≤ count a b₂) → b₁ ⊆ b₂ :=
+assume h, h
+
+lemma empty_subbag (b : bag A) : empty ⊆ b :=
+subbag.intro (take a, !zero_le)
+
+lemma eq_empty_of_subbag_empty {b : bag A} : b ⊆ empty → b = empty :=
+assume h, subbag.antisymm h (empty_subbag b)
+
+lemma union_subbag_of_subbag_of_subbag {b₁ b₂ b₃ : bag A} : b₁ ⊆ b₃ → b₂ ⊆ b₃ → b₁ ∪ b₂ ⊆ b₃ :=
+assume h₁ h₂, subbag.intro (λ a, calc
+  count a (b₁ ∪ b₂) = max (count a b₁) (count a b₂) : by rewrite count_union
+                ... ≤ count a b₃                    : max_le (h₁ a) (h₂ a))
+
+lemma subbag_inter_of_subbag_of_subbag {b₁ b₂ b₃ : bag A} : b₁ ⊆ b₂ → b₁ ⊆ b₃ → b₁ ⊆ b₂ ∩ b₃ :=
+assume h₁ h₂, subbag.intro (λ a, calc
+  count a b₁ ≤ min (count a b₂) (count a b₃) : le_min (h₁ a) (h₂ a)
+         ... = count a (b₂ ∩ b₃)             : by rewrite count_inter)
+
+lemma subbag_union_left (b₁ b₂ : bag A) : b₁ ⊆ b₁ ∪ b₂ :=
+subbag.intro (take a, by rewrite [count_union]; apply le_max_left)
+
+lemma subbag_union_right (b₁ b₂ : bag A) : b₂ ⊆ b₁ ∪ b₂ :=
+subbag.intro (take a, by rewrite [count_union]; apply le_max_right)
+
+lemma inter_subbag_left (b₁ b₂ : bag A) : b₁ ∩ b₂ ⊆ b₁ :=
+subbag.intro (take a, by rewrite [count_inter]; apply min_le_left)
+
+lemma inter_subbag_right (b₁ b₂ : bag A) : b₁ ∩ b₂ ⊆ b₂ :=
+subbag.intro (take a, by rewrite [count_inter]; apply min_le_right)
+
+lemma subbag_append_left (b₁ b₂ : bag A) : b₁ ⊆ b₁ ++ b₂ :=
+subbag.intro (take a, by rewrite [count_append]; apply le_add_right)
+
+lemma subbag_append_right (b₁ b₂ : bag A) : b₂ ⊆ b₁ ++ b₂ :=
+subbag.intro (take a, by rewrite [count_append]; apply le_add_left)
+
+lemma inter_subbag_union (b₁ b₂ : bag A) : b₁ ∩ b₂ ⊆ b₁ ∪ b₂ :=
+subbag.trans (inter_subbag_left b₁ b₂) (subbag_union_left b₁ b₂)
+
+open decidable
+
+lemma union_subbag_append (b₁ b₂ : bag A) : b₁ ∪ b₂ ⊆ b₁ ++ b₂ :=
+subbag.intro (take a, begin
+  rewrite [count_append, count_union],
+  exact (or.elim !lt_or_ge)
+   (suppose count a b₁ < count a b₂,   by rewrite [max_eq_right_of_lt this]; apply le_add_left)
+   (suppose count a b₁ ≥ count a b₂, by rewrite [max_eq_left this]; apply le_add_right)
+end)
+
+lemma subbag_insert (a : A) (b : bag A) : b ⊆ insert a b :=
+subbag.intro (take x, by_cases
+  (suppose x = a, by rewrite [this, count_insert]; apply le_succ)
+  (suppose x ≠ a, by rewrite [count_insert_of_ne this]))
+
+lemma mem_of_subbag_of_mem {a : A} {b₁ b₂ : bag A} : b₁ ⊆ b₂ → a ∈ b₁ → a ∈ b₂ :=
+assume h₁ h₂,
+have count a b₁ ≤ count a b₂, from count_le_of_subbag h₁ a,
+have count a b₁ > 0,          from h₂,
+show count a b₂ > 0,          from lt_of_lt_of_le `0 < count a b₁` `count a b₁ ≤ count a b₂`
+
+lemma extract_subbag (a : A) (b : bag A) : extract a b ⊆ b :=
+subbag.intro (take x, by_cases
+  (suppose x = a, by rewrite [this, count_extract]; apply zero_le)
+  (suppose x ≠ a, by rewrite [count_extract_of_ne this]))
+
+open bool
+
+private definition subcount : list A → list A → bool
+| []      l₂ := tt
+| (a::l₁) l₂ := if list.count a (a::l₁) ≤ list.count a l₂ then subcount l₁ l₂ else ff
+
+private lemma all_of_subcount_eq_tt : ∀ {l₁ l₂ : list A}, subcount l₁ l₂ = tt → ∀ a, list.count a l₁ ≤ list.count a l₂
+| []      l₂ h := take x, !zero_le
+| (a::l₁) l₂ h := take x,
+  have subcount l₁ l₂ = tt, from by_contradiction (suppose subcount l₁ l₂ ≠ tt,
+    have subcount l₁ l₂ = ff, from eq_ff_of_ne_tt this,
+    begin unfold subcount at h, rewrite [this at h, if_t_t at h], contradiction end),
+  have ih : ∀ a, list.count a l₁ ≤ list.count a l₂, from all_of_subcount_eq_tt this,
+  have i  : list.count a (a::l₁) ≤ list.count a l₂, from by_contradiction (suppose ¬ list.count a (a::l₁) ≤ list.count a l₂,
+    begin unfold subcount at h, rewrite [if_neg this at h], contradiction end),
+  by_cases
+    (suppose x = a, by rewrite this; apply i)
+    (suppose x ≠ a, by rewrite [list.count_cons_of_ne this]; apply ih)
+
+private lemma ex_of_subcount_eq_ff : ∀ {l₁ l₂ : list A}, subcount l₁ l₂ = ff → ∃ a, ¬ list.count a l₁ ≤ list.count a l₂
+| []     l₂ h := by contradiction
+| (a::l₁) l₂ h := by_cases
+  (suppose i : list.count a (a::l₁) ≤ list.count a l₂,
+    have subcount l₁ l₂ = ff, from by_contradiction (suppose subcount l₁ l₂ ≠ ff,
+      have subcount l₁ l₂ = tt, from eq_tt_of_ne_ff this,
+      begin
+        unfold subcount at h,
+        rewrite [if_pos i at h, this at h],
+        contradiction
+      end),
+    have ih : ∃ a, ¬ list.count a l₁ ≤ list.count a l₂, from ex_of_subcount_eq_ff this,
+    obtain w hw, from ih, by_cases
+     (suppose w = a, begin subst w, existsi a, rewrite list.count_cons_eq, apply not_lt_of_ge, apply le_of_lt (lt_of_not_ge hw) end)
+     (suppose w ≠ a, exists.intro w (by rewrite (list.count_cons_of_ne `w ≠ a`); exact hw)))
+  (suppose ¬ list.count a (a::l₁) ≤ list.count a l₂, exists.intro a this)
+
+attribute [instance]
+definition decidable_subbag (b₁ b₂ : bag A) : decidable (b₁ ⊆ b₂) :=
+quot.rec_on_subsingleton₂ b₁ b₂ (λ l₁ l₂,
+  match subcount l₁ l₂ with
+  | tt := suppose subcount l₁ l₂ = tt, inl (all_of_subcount_eq_tt this)
+  | ff := suppose subcount l₁ l₂ = ff, inr (suppose h : (∀ a, list.count a l₁ ≤ list.count a l₂),
+            obtain w hw, from ex_of_subcount_eq_ff `subcount l₁ l₂ = ff`,
+            absurd (h w) hw)
+  end rfl)
+end subbag
+end bag

old_library/data/bool.lean

@@ -0,0 +1,180 @@
+/-
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+-/
+import logic.eq
+
+namespace bool
+  local attribute bor [reducible]
+  local attribute band [reducible]
+
+  theorem dichotomy (b : bool) : b = ff ∨ b = tt :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem cond_ff {A : Type} (t e : A) : cond ff t e = e :=
+  rfl
+
+  attribute [simp]
+  theorem cond_tt {A : Type} (t e : A) : cond tt t e = t :=
+  rfl
+
+  theorem eq_tt_of_ne_ff : ∀ {a : bool}, a ≠ ff → a = tt :=
+  sorry -- by rec_simp
+
+  theorem eq_ff_of_ne_tt : ∀ {a : bool}, a ≠ tt → a = ff :=
+  sorry -- by rec_simp
+
+  theorem absurd_of_eq_ff_of_eq_tt {B : Prop} {a : bool} (H₁ : a = ff) (H₂ : a = tt) : B :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem tt_bor (a : bool) : bor tt a = tt :=
+  rfl
+
+  notation a || b := bor a b
+
+  attribute [simp]
+  theorem bor_tt (a : bool) : a || tt = tt :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem ff_bor (a : bool) : ff || a = a :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem bor_ff (a : bool) : a || ff = a :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem bor_self (a : bool) : a || a = a :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem bor_comm (a b : bool) : a || b = b || a :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem bor_assoc (a b c : bool) : (a || b) || c = a || (b || c) :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem bor_left_comm (a b c : bool) : a || (b || c) = b || (a || c) :=
+  sorry -- by rec_simp
+
+  theorem or_of_bor_eq {a b : bool} : a || b = tt → a = tt ∨ b = tt :=
+  sorry -- by rec_simp
+
+  theorem bor_inl {a b : bool} (H : a = tt) : a || b = tt :=
+  sorry -- by rec_simp
+
+  theorem bor_inr {a b : bool} (H : b = tt) : a || b = tt :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem ff_band (a : bool) : ff && a = ff :=
+  rfl
+
+  attribute [simp]
+  theorem tt_band (a : bool) : tt && a = a :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem band_ff (a : bool) : a && ff = ff :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem band_tt (a : bool) : a && tt = a :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem band_self (a : bool) : a && a = a :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem band_comm (a b : bool) : a && b = b && a :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem band_assoc (a b c : bool) : (a && b) && c = a && (b && c) :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem band_left_comm (a b c : bool) : a && (b && c) = b && (a && c) :=
+  sorry -- by rec_simp
+
+  theorem band_elim_left {a b : bool} (H : a && b = tt) : a = tt :=
+  sorry -- by rec_simp
+
+  theorem band_intro {a b : bool} (H₁ : a = tt) (H₂ : b = tt) : a && b = tt :=
+  sorry -- by rec_simp
+
+  theorem band_elim_right {a b : bool} (H : a && b = tt) : b = tt :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  theorem bnot_false : bnot ff = tt :=
+  rfl
+
+  attribute [simp]
+  theorem bnot_true : bnot tt = ff :=
+  rfl
+
+  attribute [simp]
+  theorem bnot_bnot (a : bool) : bnot (bnot a) = a :=
+  sorry -- by rec_simp
+
+  theorem eq_tt_of_bnot_eq_ff {a : bool} : bnot a = ff → a = tt :=
+  sorry -- by rec_simp
+
+  theorem eq_ff_of_bnot_eq_tt {a : bool} : bnot a = tt → a = ff :=
+  sorry -- by rec_simp
+
+  definition bxor : bool → bool → bool
+  | ff ff := ff
+  | ff tt := tt
+  | tt ff := tt
+  | tt tt := ff
+
+  attribute [simp]
+  lemma ff_bxor_ff : bxor ff ff = ff := rfl
+  attribute [simp]
+  lemma ff_bxor_tt : bxor ff tt = tt := rfl
+  attribute [simp]
+  lemma tt_bxor_ff : bxor tt ff = tt := rfl
+  attribute [simp]
+  lemma tt_bxor_tt : bxor tt tt = ff := rfl
+
+  attribute [simp]
+  lemma bxor_self (a : bool) : bxor a a = ff :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  lemma bxor_ff (a : bool) : bxor a ff = a :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  lemma bxor_tt (a : bool) : bxor a tt = bnot a :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  lemma ff_bxor (a : bool) : bxor ff a = a :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  lemma tt_bxor (a : bool) : bxor tt a = bnot a :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  lemma bxor_comm (a b : bool) : bxor a b = bxor b a :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  lemma bxor_assoc (a b c : bool) : bxor (bxor a b) c = bxor a (bxor b c) :=
+  sorry -- by rec_simp
+
+  attribute [simp]
+  lemma bxor_left_comm (a b c : bool) : bxor a (bxor b c) = bxor b (bxor a c) :=
+  sorry -- by rec_simp
+end bool

old_library/data/bv.lean

@@ -0,0 +1,166 @@
+/-
+Copyright (c) 2015 Joe Hendrix. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Joe Hendrix
+
+Basic operations on bitvectors.
+
+This is a work-in-progress, and contains additions to other theories.
+-/
+import data.list
+import data.tuple
+
+namespace bv
+open bool
+open eq.ops
+open list
+open nat
+open prod
+open subtype
+open tuple
+
+attribute [reducible]
+definition bv (n : ℕ) := tuple bool n
+
+-- Create a zero bitvector
+definition bv_zero (n : ℕ) : bv n := replicate ff
+
+-- Create  a bitvector with the constant one.
+definition bv_one  : Π (n : ℕ), bv n
+  | 0 := replicate ff
+  | (succ n) := (replicate ff : bv n) ++ (tt :: nil)
+
+definition bv_cong {a b : ℕ} : (a = b) → bv a → bv b
+| c (tag x p) := tag x (c ▸ p)
+
+section shift
+
+  -- shift left
+  definition bv_shl {n:ℕ} : bv n → ℕ → bv n
+    | x i :=
+       if le : i ≤ n then
+         let r := dropn i x ++ replicate ff in
+         let eq := calc (n-i) + i = n : nat.sub_add_cancel le in
+         bv_cong eq r
+       else
+         bv_zero n
+
+  -- unsigned shift right
+  definition bv_ushr {n:ℕ} : bv n → ℕ → bv n
+    | x i :=
+      if le : i ≤ n then
+        let y : bv (n-i) := @firstn _ _ (n - i) (sub_le n i) x in
+        let eq := calc (i+(n-i)) = (n - i) + i : add.comm
+                            ...  = n           : nat.sub_add_cancel le in
+        bv_cong eq (replicate ff ++ y)
+      else
+        bv_zero n
+
+  -- signed shift right
+  definition bv_sshr {m:ℕ} : bv (succ m) → ℕ → bv (succ m)
+    | x i :=
+      let n := succ m in
+      if le : i ≤ n then
+        let z : bv i := replicate (head x) in
+        let y : bv (n-i) := @firstn _ _ (n - i) (sub_le n i) x in
+        let eq := calc (i+(n-i)) = (n-i) + i : add.comm
+                            ...  = n         : nat.sub_add_cancel le in
+        bv_cong eq (z ++ y)
+      else
+        bv_zero n
+
+end shift
+
+section bitwise
+  variable { n : ℕ }
+
+  definition bv_not : bv n → bv n := map bnot
+  definition bv_and : bv n → bv n → bv n := map₂ band
+  definition bv_or  : bv n → bv n → bv n := map₂ bor
+  definition bv_xor : bv n → bv n → bv n := map₂ bxor
+
+end bitwise
+
+section arith
+
+  variable { n : ℕ }
+
+  protected definition xor3 (x:bool) (y:bool) (c:bool) := bxor (bxor x y) c
+  protected definition carry (x:bool) (y:bool) (c:bool) :=
+    x && y || x && c || y && c
+
+  definition bv_neg : bv n → bv n
+  | x :=
+    let f := λy c, (y || c, bxor y c) in
+    pr₂ (mapAccumR f x ff)
+
+  -- Add with carry (no overflow)
+  definition bv_adc : bv n → bv n → bool → bv (n+1)
+  | x y c :=
+    let f := λx y c, (bv.carry x y c, bv.xor3 x y c) in
+    let z := tuple.mapAccumR₂ f x y c in
+    (pr₁ z) :: (pr₂ z)
+
+  definition bv_add : bv n → bv n → bv n
+  | x y := tail (bv_adc x y ff)
+
+  protected definition borrow (x:bool) (y:bool) (b:bool) :=
+    bnot x && y || bnot x && b || y && b
+
+  -- Subtract with borrow
+  definition bv_sbb : bv n → bv n → bool → bool × bv n
+  | x y b :=
+    let f := λx y c, (bv.borrow x y c, bv.xor3 x y c) in
+    tuple.mapAccumR₂ f x y b
+
+  definition bv_sub : bv n → bv n → bv n
+  | x y := pr₂ (bv_sbb x y ff)
+
+  attribute [instance]
+  definition bv_has_zero : has_zero (bv n) := has_zero.mk (bv_zero n)
+  attribute [instance]
+  definition bv_has_one  : has_one (bv n)  := has_one.mk (bv_one n)
+  attribute [instance]
+  definition bv_has_add  : has_add (bv n)  := has_add.mk bv_add
+  attribute [instance]
+  definition bv_has_sub  : has_sub (bv n)  := has_sub.mk bv_sub
+  attribute [instance]
+  definition bv_has_neg  : has_neg (bv n)  := has_neg.mk bv_neg
+
+  definition bv_mul : bv n → bv n → bv n
+  | x y :=
+    let f := λr b, cond b (r + r + y) (r + r) in
+    foldl f 0 (to_list x)
+
+  attribute [instance]
+  definition bv_has_mul  : has_mul (bv n)  := has_mul.mk bv_mul
+
+  definition bv_ult : bv n → bv n → bool := λx y, pr₁ (bv_sbb x y ff)
+  definition bv_ugt : bv n → bv n → bool := λx y, bv_ult y x
+  definition bv_ule : bv n → bv n → bool := λx y, bnot (bv_ult y x)
+  definition bv_uge : bv n → bv n → bool := λx y, bv_ule y x
+
+  definition bv_slt : bv (succ n) → bv (succ n) → bool := λx y,
+    cond (head x)
+         (cond (head y)
+               (bv_ult (tail x) (tail y))  -- both negative
+               tt)                         -- x is negative and y is not
+         (cond (head y)
+               ff                          -- y is negative and x is not
+               (bv_ult (tail x) (tail y))) -- both positive
+  definition bv_sgt : bv (succ n) → bv (succ n) → bool := λx y, bv_slt y x
+  definition bv_sle : bv (succ n) → bv (succ n) → bool := λx y, bnot (bv_slt y x)
+  definition bv_sge : bv (succ n) → bv (succ n) → bool := λx y, bv_sle y x
+end arith
+
+
+section from_bv
+  variable {A : Type}
+
+  -- Convert a bitvector to another number.
+  definition from_bv [p : has_add A] [q0 : has_zero A] [q1 : has_one A] {n:nat} (v:bv n) : A :=
+    let f := λr b, cond b (r + r + 1) (r + r) in
+    foldl f 0 (to_list v)
+end from_bv
+
+end bv

old_library/data/complex.lean

@@ -0,0 +1,375 @@
+/-
+Copyright (c) 2015 Jacob Gross. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jacob Gross, Jeremy Avigad
+
+The complex numbers.
+-/
+import data.real
+open real eq.ops
+
+record complex : Type :=
+(re : ℝ) (im : ℝ)
+
+notation `ℂ` := complex
+
+namespace complex
+
+variables (u w z : ℂ)
+variable n : ℕ
+
+protected proposition eq {z w : ℂ} (H1 : complex.re z = complex.re w)
+(H2 : complex.im z = complex.im w) : z = w :=
+begin
+  induction z,
+  induction w,
+  rewrite [H1, H2]
+end
+
+protected proposition eta (z : ℂ) : complex.mk (complex.re z) (complex.im z) = z :=
+by cases z; exact rfl
+
+-- definition of_real [coercion] (x : ℝ) : ℂ := complex.mk x 0
+-- definition of_rat [coercion] (q : ℚ) : ℂ := q
+-- definition of_int [coercion] (i : ℤ) : ℂ := i
+-- definition of_nat [coercion] (n : ℕ) : ℂ := n
+-- definition of_num [coercion] [reducible] (n : num) : ℂ := n
+
+protected definition prio : num := num.pred real.prio
+
+attribute [instance, priority complex.prio]
+definition complex_has_zero : has_zero ℂ :=
+has_zero.mk (of_nat 0)
+
+attribute [instance, priority complex.prio]
+definition complex_has_one : has_one ℂ :=
+has_one.mk (of_nat 1)
+
+theorem re_of_real (x : ℝ) : re (of_real x) = x := rfl
+
+theorem im_of_real (x : ℝ) : im (of_real x) = 0 := rfl
+
+protected definition add (z w : ℂ) : ℂ :=
+complex.mk (complex.re z + complex.re w) (complex.im z + complex.im w)
+
+protected definition neg (z : ℂ) : ℂ :=
+complex.mk (-(re z)) (-(im z))
+
+protected definition mul (z w : ℂ) : ℂ :=
+complex.mk
+  (complex.re w * complex.re z - complex.im w * complex.im z)
+  (complex.re w * complex.im z + complex.im w * complex.re z)
+
+/- notation -/
+
+attribute [instance, priority complex.prio]
+definition complex_has_add : has_add complex :=
+has_add.mk complex.add
+
+attribute [instance, priority complex.prio]
+definition complex_has_neg : has_neg complex :=
+has_neg.mk complex.neg
+
+attribute [instance, priority complex.prio]
+definition complex_has_mul : has_mul complex :=
+has_mul.mk complex.mul
+
+protected theorem add_def (z w : ℂ) :
+  z + w = complex.mk (complex.re z + complex.re w) (complex.im z + complex.im w) := rfl
+
+protected theorem neg_def (z : ℂ) : -z = complex.mk (-(re z)) (-(im z)) := rfl
+
+protected theorem mul_def (z w : ℂ) :
+  z * w = complex.mk
+    (complex.re w * complex.re z - complex.im w * complex.im z)
+    (complex.re w * complex.im z + complex.im w * complex.re z) := rfl
+
+-- TODO: what notation should we use for i?
+
+definition ii := complex.mk 0 1
+
+theorem i_mul_i : ii * ii = -1 := rfl
+
+/- basic properties -/
+
+protected theorem add_comm (w z : ℂ) : w + z = z + w :=
+complex.eq !add.comm !add.comm
+
+protected theorem add_assoc (w z u : ℂ) : (w + z) + u = w + (z + u) :=
+complex.eq !add.assoc !add.assoc
+
+protected theorem add_zero (z : ℂ) : z + 0 = z :=
+complex.eq !add_zero !add_zero
+
+protected theorem zero_add (z : ℂ) : 0 + z = z := !complex.add_comm ▸ !complex.add_zero
+
+definition smul (x : ℝ) (z : ℂ) : ℂ :=
+complex.mk (x*re z) (x*im z)
+
+protected theorem add_right_inv : z + - z = 0 :=
+complex.eq !add.right_inv !add.right_inv
+
+protected theorem add_left_inv : - z + z = 0 :=
+!complex.add_comm ▸ !complex.add_right_inv
+
+protected theorem mul_comm : w * z = z * w :=
+by rewrite [*complex.mul_def, *mul.comm (re w), *mul.comm (im w), add.comm]
+
+protected theorem one_mul :  1 * z = z :=
+by krewrite [complex.mul_def, *mul_one, *mul_zero, sub_zero, zero_add, complex.eta]
+
+protected theorem mul_one :  z * 1 = z := !complex.mul_comm ▸ !complex.one_mul
+
+protected theorem left_distrib  : u * (w + z) = u * w + u * z :=
+begin
+  rewrite [*complex.mul_def, *complex.add_def, ▸*, *right_distrib, -sub_sub, *sub_eq_add_neg],
+  rewrite [*add.assoc, add.left_comm (re z * im u), add.left_comm (-_)]
+end
+
+protected theorem right_distrib : (u + w) * z = u * z + w * z :=
+by rewrite [*complex.mul_comm _ z, complex.left_distrib]
+
+protected theorem mul_assoc : (u * w) * z = u * (w * z) :=
+begin
+  rewrite [*complex.mul_def, ▸*, *sub_eq_add_neg, *left_distrib, *right_distrib, *neg_add],
+  rewrite [-*neg_mul_eq_neg_mul, -*neg_mul_eq_mul_neg, *add.assoc, *mul.assoc],
+  rewrite [add.comm (-(im z * (im w * _))), add.comm (-(im z * (im w * _))), *add.assoc]
+end
+
+theorem re_add (z w : ℂ) : re (z + w) = re z + re w := rfl
+
+theorem im_add (z w : ℂ) : im (z + w) = im z + im w := rfl
+
+/- coercions -/
+
+theorem of_real_add (a b : ℝ) : of_real (a + b) = of_real a + of_real b := rfl
+
+theorem of_real_mul (a b : ℝ) : of_real (a * b) = (of_real a) * (of_real b) :=
+by rewrite [complex.mul_def, *re_of_real, *im_of_real, *mul_zero, *zero_mul, sub_zero, add_zero,
+           mul.comm]
+
+theorem of_real_neg (a : ℝ) : of_real (-a) = -(of_real a) := rfl
+
+theorem of_real.inj {a b : ℝ} (H : of_real a = of_real b) : a = b :=
+show re (of_real a) = re (of_real b), from congr_arg re H
+
+theorem eq_of_of_real_eq_of_real {a b : ℝ} (H : of_real a = of_real b) : a = b :=
+of_real.inj H
+
+theorem of_real_eq_of_real_iff (a b : ℝ) : of_real a = of_real b ↔ a = b :=
+iff.intro eq_of_of_real_eq_of_real !congr_arg
+
+/- make complex an instance of ring -/
+
+attribute [reducible]
+protected definition comm_ring : comm_ring complex :=
+  begin
+    fapply comm_ring.mk,
+    exact complex.add,
+    exact complex.add_assoc,
+    exact 0,
+    exact complex.zero_add,
+    exact complex.add_zero,
+    exact complex.neg,
+    exact complex.add_left_inv,
+    exact complex.add_comm,
+    exact complex.mul,
+    exact complex.mul_assoc,
+    exact 1,
+    apply complex.one_mul,
+    apply complex.mul_one,
+    apply complex.left_distrib,
+    apply complex.right_distrib,
+    apply complex.mul_comm
+  end
+
+local attribute complex.comm_ring [instance]
+
+attribute [instance, priority complex.prio]
+definition complex_has_sub : has_sub complex :=
+has_sub.mk has_sub.sub
+
+theorem of_real_sub (x y : ℝ) : of_real (x - y) = of_real x - of_real y :=
+rfl
+
+/- complex modulus and conjugate-/
+
+definition cmod (z : ℂ) : ℝ :=
+(complex.re z) * (complex.re z) + (complex.im z) * (complex.im z)
+
+theorem cmod_zero : cmod 0 = 0 := rfl
+
+theorem cmod_of_real (x : ℝ) : cmod x = x * x :=
+by rewrite [↑cmod, re_of_real, im_of_real, mul_zero, add_zero]
+
+theorem eq_zero_of_cmod_eq_zero {z : ℂ} (H : cmod z = 0) : z = 0 :=
+have H1 : (complex.re z) * (complex.re z) + (complex.im z) * (complex.im z) = 0,
+  from H,
+have H2 : complex.re z = 0, from eq_zero_of_mul_self_add_mul_self_eq_zero H1,
+have H3 : complex.im z = 0, from eq_zero_of_mul_self_add_mul_self_eq_zero (!add.comm ▸ H1),
+show z = 0, from complex.eq H2 H3
+
+definition conj (z : ℂ) : ℂ := complex.mk (complex.re z) (-(complex.im z))
+
+theorem conj_of_real {x : ℝ} : conj (of_real x) = of_real x := rfl
+
+theorem conj_add (z w : ℂ) : conj (z + w) = conj z + conj w :=
+by rewrite [↑conj, *complex.add_def, ▸*, neg_add]
+
+theorem conj_mul (z w : ℂ) : conj (z * w) = conj z * conj w :=
+by rewrite [↑conj, *complex.mul_def, ▸*, neg_mul_neg, neg_add,
+            -neg_mul_eq_mul_neg, -neg_mul_eq_neg_mul]
+
+theorem conj_conj (z : ℂ) : conj (conj z) = z :=
+by rewrite [↑conj, neg_neg, complex.eta]
+
+theorem mul_conj_eq_of_real_cmod (z : ℂ) : z * conj z = of_real (cmod z) :=
+by rewrite [↑conj, ↑cmod, ↑of_real, complex.mul_def, ▸*, -*neg_mul_eq_neg_mul,
+            sub_neg_eq_add, mul.comm (re z) (im z), add.right_inv]
+
+theorem cmod_conj (z : ℂ) : cmod (conj z) = cmod z :=
+begin
+  apply eq_of_of_real_eq_of_real,
+  rewrite [-*mul_conj_eq_of_real_cmod, conj_conj, mul.comm]
+end
+
+theorem cmod_mul (z w : ℂ) : cmod (z * w) = cmod z * cmod w :=
+begin
+  apply eq_of_of_real_eq_of_real,
+  rewrite [of_real_mul, -*mul_conj_eq_of_real_cmod, conj_mul, *mul.assoc, mul.left_comm w]
+end
+
+protected noncomputable definition inv (z : ℂ) : complex := conj z * of_real (cmod z)⁻¹
+
+attribute [instance, priority complex.prio]
+protected noncomputable definition complex_has_inv :
+  has_inv complex := has_inv.mk complex.inv
+
+protected theorem inv_def (z : ℂ) : z⁻¹ = conj z * of_real (cmod z)⁻¹ := rfl
+
+protected theorem inv_zero : 0⁻¹ = (0 : ℂ) :=
+by krewrite [complex.inv_def, conj_of_real, zero_mul]
+
+theorem of_real_inv (x : ℝ) : of_real x⁻¹ = (of_real x)⁻¹ :=
+classical.by_cases
+  (assume H : x = 0,
+    by krewrite [H, inv_zero, complex.inv_zero])
+  (assume H : x ≠ 0,
+    by rewrite [complex.inv_def, cmod_of_real, conj_of_real, mul_inv_eq H H, -of_real_mul,
+               -mul.assoc, mul_inv_cancel H, one_mul])
+
+protected noncomputable definition div (z w : ℂ) : ℂ := z * w⁻¹
+
+attribute [instance, priority complex.prio]
+noncomputable definition complex_has_div :
+    has_div complex :=
+  has_div.mk complex.div
+
+protected theorem div_def (z w : ℂ) : z / w = z * w⁻¹ := rfl
+
+theorem of_real_div (x y : ℝ) : of_real (x / y) = of_real x / of_real y :=
+have H : x / y = x * y⁻¹, from rfl,
+by rewrite [H, complex.div_def, of_real_mul, of_real_inv]
+
+theorem conj_inv (z : ℂ) : (conj z)⁻¹ = conj (z⁻¹) :=
+by rewrite [*complex.inv_def, conj_mul, *conj_conj, conj_of_real, cmod_conj]
+
+protected theorem mul_inv_cancel {z : ℂ} (H : z ≠ 0) : z * z⁻¹ = 1 :=
+by rewrite [complex.inv_def, -mul.assoc, mul_conj_eq_of_real_cmod, -of_real_mul,
+            mul_inv_cancel (assume H', H (eq_zero_of_cmod_eq_zero H'))]
+
+protected theorem inv_mul_cancel {z : ℂ} (H : z ≠ 0) : z⁻¹ * z = 1 :=
+!mul.comm ▸ complex.mul_inv_cancel H
+
+protected noncomputable definition has_decidable_eq : decidable_eq ℂ :=
+take z w, classical.prop_decidable (z = w)
+
+protected theorem zero_ne_one : (0 : ℂ) ≠ 1 :=
+assume H, zero_ne_one (eq_of_of_real_eq_of_real H)
+
+attribute [trans_instance]
+protected noncomputable definition discrete_field :
+  discrete_field ℂ :=
+⦃ discrete_field, complex.comm_ring,
+  mul_inv_cancel   := @complex.mul_inv_cancel,
+  inv_mul_cancel   := @complex.inv_mul_cancel,
+  zero_ne_one      := complex.zero_ne_one,
+  inv_zero         := complex.inv_zero,
+  has_decidable_eq := complex.has_decidable_eq
+⦄
+
+-- TODO : we still need the whole family of coercion properties, for nat, int, rat
+
+-- coercions
+
+theorem of_rat_eq (a : ℚ) : of_rat a = of_real (real.of_rat a) := rfl
+
+theorem of_int_eq (a : ℤ) : of_int a = of_real (real.of_int a) := rfl
+
+theorem of_nat_eq (a : ℕ) : of_nat a = of_real (real.of_nat a) := rfl
+
+theorem of_rat.inj {x y : ℚ} (H : of_rat x = of_rat y) : x = y :=
+real.of_rat.inj (of_real.inj H)
+
+theorem eq_of_of_rat_eq_of_rat {x y : ℚ} (H : of_rat x = of_rat y) : x = y :=
+of_rat.inj H
+
+theorem of_rat_eq_of_rat_iff (x y : ℚ) : of_rat x = of_rat y ↔ x = y :=
+iff.intro eq_of_of_rat_eq_of_rat !congr_arg
+
+theorem of_int.inj {a b : ℤ} (H : of_int a = of_int b) : a = b :=
+rat.of_int.inj (of_rat.inj H)
+
+theorem eq_of_of_int_eq_of_int {a b : ℤ} (H : of_int a = of_int b) : a = b :=
+of_int.inj H
+
+theorem of_int_eq_of_int_iff (a b : ℤ) : of_int a = of_int b ↔ a = b :=
+iff.intro of_int.inj !congr_arg
+
+theorem of_nat.inj {a b : ℕ} (H : of_nat a = of_nat b) : a = b :=
+int.of_nat.inj (of_int.inj H)
+
+theorem eq_of_of_nat_eq_of_nat {a b : ℕ} (H : of_nat a = of_nat b) : a = b :=
+of_nat.inj H
+
+theorem of_nat_eq_of_nat_iff (a b : ℕ) : of_nat a = of_nat b ↔ a = b :=
+iff.intro of_nat.inj !congr_arg
+
+open rat
+
+theorem of_rat_add (a b : ℚ) : of_rat (a + b) = of_rat a + of_rat b :=
+by rewrite [of_rat_eq]
+
+theorem of_rat_neg (a : ℚ) : of_rat (-a) = -of_rat a :=
+by rewrite [of_rat_eq]
+
+-- these show why we have to use krewrite in the next theorem: there are
+-- two different instances of "has_mul".
+
+-- set_option pp.notation false
+-- set_option pp.coercions true
+-- set_option pp.implicit true
+
+theorem of_rat_mul (a b : ℚ) : of_rat (a * b) = of_rat a * of_rat b :=
+by krewrite [of_rat_eq, real.of_rat_mul, of_real_mul]
+
+open int
+
+theorem of_int_add (a b : ℤ) : of_int (a + b) = of_int a + of_int b :=
+  by krewrite [of_int_eq, real.of_int_add, of_real_add]
+
+theorem of_int_neg (a : ℤ) : of_int (-a) = -of_int a :=
+  by krewrite [of_int_eq, real.of_int_neg, of_real_neg]
+
+theorem of_int_mul (a b : ℤ) : of_int (a * b) = of_int a * of_int b :=
+  by krewrite [of_int_eq, real.of_int_mul, of_real_mul]
+
+open nat
+
+theorem of_nat_add (a b : ℕ) : of_nat (a + b) = of_nat a + of_nat b :=
+  by krewrite [of_nat_eq, real.of_nat_add, of_real_add]
+
+theorem of_nat_mul (a b : ℕ) : of_nat (a * b) = of_nat a * of_nat b :=
+  by krewrite [of_nat_eq, real.of_nat_mul, of_real_mul]
+
+end complex

old_library/data/countable.lean

@@ -0,0 +1,10 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+
+Define countable types
+-/
+open function
+
+definition countable (A : Type) : Prop := ∃ f : A → nat, injective f

old_library/data/data.md

@@ -0,0 +1,37 @@
+data
+====
+
+Various data types.
+
+Basic types:
+
+* [empty](empty.lean) : the empty type
+* [unit](unit.lean) : the singleton type
+* [bool](bool.lean) : the boolean values
+* [num](num.lean) : generic numerals
+* [string](string.lean) : ascii strings
+* [nat](nat/nat.md) : the natural numbers
+* [fin](fin.lean) : finite ordinals
+* [int](int/int.md) : the integers
+* [rat](rat/rat.md) : the rationals
+* [pnat](pnat.lean) : the positive natural numbers
+* [real](real/real.md) : the real numbers
+* [complex](complex.lean) : the complex numbers
+
+Constructors:
+
+* [prod](prod.lean) : cartesian product
+* [sum](sum.lean)
+* [sigma](sigma.lean) : the dependent product
+* [uprod](uprod.lean) : unordered pairs
+* [option](option.lean)
+* [squash](squash.lean) : propositional truncation
+* [list](list/list.md)
+* [finset](finset/finset.md) : finite sets
+* [stream](stream.lean)
+* [set](set/set.md)
+
+Types with extra information:
+
+* [fintype](fintype/fintype.md) : finite types
+* [encodable](encodable.lean) : types with a coding to nat

old_library/data/default.lean

@@ -0,0 +1,10 @@
+/-
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+-/
+
+import .empty .bool .num .nat .list
+--  .set
+-- import .string .int .rat .fintype .prod .sum .sigma .option .list .finset .set .stream
+-- import .fin .real .complex

old_library/data/empty.lean

@@ -0,0 +1,39 @@
+/-
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad, Floris van Doorn
+-/
+import logic.cast
+
+namespace empty
+  protected definition elim (A : Type) : empty → A :=
+  empty.rec (λe, A)
+
+  attribute [instance]
+  protected definition subsingleton : subsingleton empty :=
+  subsingleton.intro (λ a b, empty.elim _ a)
+end empty
+
+attribute [instance]
+protected definition empty.has_decidable_eq : decidable_eq empty :=
+take (a b : empty), decidable.tt (empty.elim _ a)
+
+definition tneg.tneg (A : Type) := A → empty
+prefix `~` := tneg.tneg
+namespace tneg
+variables {A B : Type}
+protected definition intro (H : A → empty)        : ~A     := H
+protected definition elim  (H1 : ~A) (H2 : A)     : empty  := H1 H2
+protected definition empty                        : ~empty := λH : empty, H
+definition tabsurd         (H1 : A) (H2 : ~A)     : B      := empty.elim _ (H2 H1)
+definition tneg_tneg_intro (H : A)                : ~~A    := λH2 : ~A, tneg.elim H2 H
+definition tmt             (H1 : A → B) (H2 : ~B) : ~A     := λHA : A, tabsurd (H1 HA) H2
+
+definition tneg_pi_left {B : A → Type} (H : ~Πa, B a) : ~~A :=
+λHnA : ~A, tneg.elim H (λHA : A, tabsurd HA HnA)
+
+definition tneg_function_right (H : ~(A → B)) : ~B :=
+λHB : B, tneg.elim H (λHA : A, HB)
+
+
+end tneg

old_library/data/encodable.lean

@@ -0,0 +1,483 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+
+Type class for encodable types.
+Note that every encodable type is countable.
+-/
+import data.fintype data.list data.list.sort data.sum data.nat.div data.countable data.equiv
+import data.finset
+open option list nat function
+
+structure encodable [class] (A : Type) :=
+(encode : A → nat) (decode : nat → option A) (encodek : ∀ a, decode (encode a) = some a)
+
+open encodable
+
+definition countable_of_encodable {A : Type} : encodable A → countable A :=
+assume e : encodable A,
+have injective encode, from
+  λ (a₁ a₂ : A) (h : encode a₁ = encode a₂),
+    have decode A (encode a₁) = decode A (encode a₂), by rewrite h,
+    by rewrite [*encodek at this]; injection this; assumption,
+exists.intro encode this
+
+attribute [instance]
+definition encodable_fintype {A : Type} [h₁ : fintype A] [h₂ : decidable_eq A] :
+  encodable A :=
+encodable.mk
+  (λ a, find a (elements_of A))
+  (λ n, nth (elements_of A) n)
+  (λ a, find_nth (fintype.complete a))
+
+attribute [instance]
+definition encodable_nat : encodable nat :=
+encodable.mk (λ a, a) (λ n, some n) (λ a, rfl)
+
+attribute [instance]
+definition encodable_option {A : Type} [h : encodable A] : encodable (option A) :=
+encodable.mk
+  (λ o, match o with
+        | some a := succ (encode a)
+        | none := 0
+        end)
+  (λ n, if n = 0 then some none else some (decode A (pred n)))
+  (λ o,
+    begin
+    cases o with a,
+      begin esimp end,
+      begin esimp, rewrite [if_neg !succ_ne_zero, encodable.encodek] end
+    end)
+
+section sum
+variables {A B : Type}
+variables [h₁ : encodable A] [h₂ : encodable B]
+include h₁ h₂
+
+private definition encode_sum : sum A B → nat
+| (sum.inl a) := 2 * encode a
+| (sum.inr b) := 2 * encode b + 1
+
+private definition decode_sum (n : nat) : option (sum A B) :=
+if n % 2 = 0 then
+   match decode A (n / 2) with
+   | some a := some (sum.inl a)
+   | none   := none
+   end
+else
+   match decode B ((n - 1) / 2) with
+   | some b := some (sum.inr b)
+   | none   := none
+   end
+
+open decidable
+private theorem decode_encode_sum : ∀ s : sum A B, decode_sum (encode_sum s) = some s
+| (sum.inl a) :=
+  have aux : 2 > (0:nat), from dec_trivial,
+  begin
+    esimp [encode_sum, decode_sum],
+    rewrite [mul_mod_right, if_pos (eq.refl (0 : nat)), nat.mul_div_cancel_left _ aux,
+             encodable.encodek]
+  end
+| (sum.inr b) :=
+  have aux₁ : 2 > (0:nat),       from dec_trivial,
+  have aux₂ : 1 % 2 = (1:nat), by rewrite [nat.mod_def],
+  have aux₃ : 1 ≠ (0:nat),       from dec_trivial,
+  begin
+    esimp [encode_sum, decode_sum],
+    rewrite [add.comm, add_mul_mod_self_left, aux₂, if_neg aux₃, nat.add_sub_cancel_left,
+             nat.mul_div_cancel_left _ aux₁, encodable.encodek]
+  end
+
+attribute [instance]
+definition encodable_sum : encodable (sum A B) :=
+encodable.mk
+  (λ s, encode_sum s)
+  (λ n, decode_sum n)
+  (λ s, decode_encode_sum s)
+end sum
+
+section prod
+variables {A B : Type}
+variables [h₁ : encodable A] [h₂ : encodable B]
+include h₁ h₂
+
+private definition encode_prod : A × B → nat
+| (a, b) := mkpair (encode a) (encode b)
+
+private definition decode_prod (n : nat) : option (A × B) :=
+match unpair n with
+| (n₁, n₂) :=
+  match decode A n₁ with
+  | some a :=
+    match decode B n₂ with
+    | some b := some (a, b)
+    | none   := none
+    end
+  | none   := none
+  end
+end
+
+private theorem decode_encode_prod : ∀ p : A × B, decode_prod (encode_prod p) = some p
+| (a, b) :=
+  begin
+    esimp [encode_prod, decode_prod, prod.cases_on],
+    rewrite [unpair_mkpair],
+    esimp,
+    rewrite [*encodable.encodek]
+  end
+
+attribute [instance]
+definition encodable_product : encodable (A × B) :=
+encodable.mk
+  encode_prod
+  decode_prod
+  decode_encode_prod
+end prod
+
+section list
+variables {A : Type}
+variables [h : encodable A]
+include h
+
+private definition encode_list_core : list A → nat
+| []     := 0
+| (a::l) := mkpair (encode a) (encode_list_core l)
+
+private theorem encode_list_core_cons (a : A) (l : list A) : encode_list_core (a::l) = mkpair (encode a) (encode_list_core l) :=
+rfl
+
+private definition encode_list (l : list A) : nat :=
+mkpair (length l) (encode_list_core l)
+
+private definition decode_list_core : nat → nat → option (list A)
+| 0        v  := some []
+| (succ n) v  :=
+  match unpair v with
+  | (v₁, v₂) :=
+    match decode A v₁ with
+    | some a :=
+      match decode_list_core n v₂ with
+      | some l := some (a::l)
+      | none   := none
+      end
+    | none   := none
+    end
+  end
+
+private theorem decode_list_core_succ (n v : nat) :
+  decode_list_core (succ n) v =
+    match unpair v with
+    | (v₁, v₂) :=
+      match decode A v₁ with
+      | some a :=
+        match decode_list_core n v₂ with
+        | some l := some (a::l)
+        | none   := none
+        end
+      | none   := none
+      end
+    end
+:= rfl
+
+private definition decode_list (n : nat) : option (list A) :=
+match unpair n with
+| (l, v) := decode_list_core l v
+end
+
+private theorem decode_encode_list_core : ∀ l : list A, decode_list_core (length l) (encode_list_core l) = some l
+| []     := rfl
+| (a::l) :=
+  begin
+    rewrite [encode_list_core_cons, length_cons, add_one (length l), decode_list_core_succ],
+    rewrite [unpair_mkpair],
+    esimp [prod.cases_on],
+    rewrite [decode_encode_list_core l],
+    rewrite [encodable.encodek],
+  end
+
+private theorem decode_encode_list (l : list A) : decode_list (encode_list l) = some l :=
+begin
+  esimp [encode_list, decode_list],
+  rewrite [unpair_mkpair],
+  esimp [prod.cases_on],
+  apply decode_encode_list_core
+end
+
+attribute [instance]
+definition encodable_list : encodable (list A) :=
+encodable.mk
+  encode_list
+  decode_list
+  decode_encode_list
+end list
+
+section finset
+variable {A : Type}
+variable [encA : encodable A]
+include encA
+
+private definition enle (a b : A) : Prop := encode a ≤ encode b
+
+private lemma enle.refl (a : A) : enle a a :=
+!le.refl
+
+private lemma enle.trans (a b c : A) : enle a b → enle b c → enle a c :=
+assume h₁ h₂, le.trans h₁ h₂
+
+private lemma enle.total (a b : A) : enle a b ∨ enle b a :=
+!le.total
+
+private lemma enle.antisymm (a b : A) : enle a b → enle b a → a = b :=
+assume h₁ h₂,
+have encode a = encode b, from le.antisymm h₁ h₂,
+have decode A (encode a) = decode A (encode b), by rewrite this,
+have some a = some b, by rewrite [*encodek at this]; exact this,
+option.no_confusion this (λ e, e)
+
+attribute [instance]
+private definition decidable_enle (a b : A) : decidable (enle a b) :=
+decidable_le (encode a) (encode b)
+
+variables [decA : decidable_eq A]
+include decA
+
+private definition ensort (l : list A) : list A :=
+sort enle l
+
+open subtype perm
+private lemma sorted_eq_of_perm {l₁ l₂ : list A} (h : l₁ ~ l₂) : ensort l₁ = ensort l₂ :=
+list.sort_eq_of_perm_core enle.total enle.trans enle.refl enle.antisymm h
+
+private definition encode_finset (s : finset A) : nat :=
+quot.lift_on s
+  (λ l, encode (ensort (elt_of l)))
+  (λ l₁ l₂ p,
+    have elt_of l₁ ~ elt_of l₂,                     from p,
+    have ensort (elt_of l₁) = ensort (elt_of l₂), from sorted_eq_of_perm this,
+    by rewrite this)
+
+private definition decode_finset (n : nat) : option (finset A) :=
+match decode (list A) n with
+| some l₁ := some (finset.to_finset l₁)
+| none    := none
+end
+
+private theorem decode_encode_finset (s : finset A) : decode_finset (encode_finset s) = some s :=
+quot.induction_on s (λ l,
+  begin
+    unfold encode_finset, unfold decode_finset, rewrite encodek, esimp, congruence,
+    apply quot.sound, cases l with l nd,
+    show erase_dup (ensort l) ~ l, from
+      have nodup (ensort l), from nodup_of_perm_of_nodup (perm.symm !sort_perm) nd,
+      calc erase_dup (ensort l) = ensort l : erase_dup_eq_of_nodup this
+                ...             ~ l        : sort_perm
+  end)
+
+attribute [instance]
+definition encodable_finset : encodable (finset A) :=
+encodable.mk
+  encode_finset
+  decode_finset
+  decode_encode_finset
+end finset
+
+section subtype
+open subtype decidable
+variable {A : Type}
+variable {P : A → Prop}
+variable [encA : encodable A]
+variable [decP : decidable_pred P]
+
+include encA
+private definition encode_subtype : {a : A | P a} → nat
+| (tag v h) := encode v
+
+include decP
+private definition decode_subtype (v : nat) : option {a : A | P a} :=
+match decode A v with
+| some a := if h : P a then some (tag a h) else none
+| none   := none
+end
+
+private lemma decode_encode_subtype : ∀ s : {a : A | P a}, decode_subtype (encode_subtype s) = some s
+| (tag v h) :=
+  begin
+    unfold [encode_subtype, decode_subtype], rewrite encodek, esimp,
+    rewrite [dif_pos h]
+  end
+
+attribute [instance]
+definition encodable_subtype : encodable {a : A | P a} :=
+encodable.mk
+  encode_subtype
+  decode_subtype
+  decode_encode_subtype
+end subtype
+
+definition encodable_of_left_injection
+             {A B : Type} [h₁ : encodable A]
+             (f : B → A) (finv : A → option B) (linv : ∀ b, finv (f b) = some b) : encodable B :=
+encodable.mk
+  (λ b, encode (f b))
+  (λ n,
+    match decode A n with
+    | some a := finv a
+    | none   := none
+    end)
+  (λ b,
+    begin
+      esimp,
+      rewrite [encodable.encodek],
+      esimp [option.cases_on],
+      rewrite [linv]
+    end)
+
+section
+open equiv
+
+definition encodable_of_equiv {A B : Type} [h : encodable A] : A ≃ B → encodable B
+| (mk f g l r) :=
+  encodable_of_left_injection g (λ a, some (f a))
+    (λ b, by rewrite r; reflexivity)
+end
+
+/-
+Choice function for encodable types  and decidable predicates.
+We provide the following API
+
+choose      {A : Type} {p : A → Prop} [c : encodable A] [d : decidable_pred p] : (∃ x, p x) → A :=
+choose_spec {A : Type} {p : A → Prop} [c : encodable A] [d : decidable_pred p] (ex : ∃ x, p x) : p (choose ex) :=
+-/
+section find_a
+parameters {A : Type} {p : A → Prop} [c : encodable A] [d : decidable_pred p]
+include c
+include d
+
+private definition pn (n : nat) : Prop :=
+match decode A n with
+| some a := p a
+| none   := false
+end
+
+private definition decidable_pn : decidable_pred pn :=
+λ n,
+match decode A n with
+| some a := λ e : decode A n = some a,
+  match d a with
+  | decidable.inl t :=
+    begin
+      unfold pn, rewrite e, esimp [option.cases_on],
+      exact (decidable.inl t)
+    end
+  | decidable.inr f :=
+    begin
+      unfold pn, rewrite e, esimp [option.cases_on],
+      exact (decidable.inr f)
+    end
+  end
+| none   := λ e : decode A n = none,
+  begin
+    unfold pn, rewrite e, esimp [option.cases_on],
+    exact decidable_false
+  end
+end (eq.refl (decode A n))
+
+private definition ex_pn_of_ex : (∃ x, p x) → (∃ x, pn x) :=
+assume ex,
+obtain (w : A) (pw : p w), from ex,
+exists.intro (encode w)
+  begin
+    unfold pn, rewrite [encodek], esimp, exact pw
+  end
+
+private lemma decode_ne_none_of_pn {n : nat} : pn n → decode A n ≠ none :=
+assume pnn e,
+begin
+  rewrite [▸ (match decode A n with | some a := p a | none   := false end) at pnn],
+  rewrite [e at pnn], esimp [option.cases_on] at pnn,
+  exact (false.elim pnn)
+end
+
+open subtype
+
+private definition of_nat (n : nat) : pn n → { a : A | p a } :=
+match decode A n with
+| some a := λ (e : decode A n = some a),
+  begin
+    unfold pn, rewrite e, esimp [option.cases_on], intro pa,
+    exact (tag a pa)
+  end
+| none   := λ (e : decode A n = none) h, absurd e (decode_ne_none_of_pn h)
+end (eq.refl (decode A n))
+
+private definition find_a : (∃ x, p x) → {a : A | p a} :=
+suppose ∃ x, p x,
+have    ∃ x, pn x, from ex_pn_of_ex this,
+let r := @nat.find _ decidable_pn this in
+have pn r, from @nat.find_spec pn decidable_pn this,
+of_nat r this
+end find_a
+
+namespace encodable
+open subtype
+
+definition choose {A : Type} {p : A → Prop} [c : encodable A] [d : decidable_pred p] : (∃ x, p x) → A :=
+assume ex, elt_of (find_a ex)
+
+theorem choose_spec {A : Type} {p : A → Prop} [c : encodable A] [d : decidable_pred p] (ex : ∃ x, p x) : p (choose ex) :=
+has_property (find_a ex)
+
+theorem axiom_of_choice {A : Type} {B : A → Type} {R : Π x, B x → Prop} [c : Π a, encodable (B a)] [d : ∀ x y, decidable (R x y)]
+                        : (∀x, ∃y, R x y) → ∃f, ∀x, R x (f x) :=
+assume H,
+have ∀x, R x (choose (H x)), from take x, choose_spec (H x),
+exists.intro _ this
+
+theorem skolem {A : Type} {B : A → Type} {P : Π x, B x → Prop} [c : Π a, encodable (B a)] [d : ∀ x y, decidable (P x y)]
+               : (∀x, ∃y, P x y) ↔ ∃f, (∀x, P x (f x)) :=
+iff.intro
+  (suppose (∀ x, ∃y, P x y), axiom_of_choice this)
+  (suppose (∃ f, (∀x, P x (f x))),
+   take x, obtain (fw : ∀x, B x) (Hw : ∀x, P x (fw x)), from this,
+     exists.intro (fw x) (Hw x))
+end encodable
+
+namespace quot
+section
+open setoid encodable
+parameter {A : Type}
+parameter {s : setoid A}
+parameter [decR : ∀ a b : A, decidable (a ≈ b)]
+parameter [encA : encodable A]
+include decR
+include encA
+
+-- Choose equivalence class representative
+definition rep (q : quot s) : A :=
+choose (exists_rep q)
+
+theorem rep_spec (q : quot s) : ⟦rep q⟧ = q :=
+choose_spec (exists_rep q)
+
+private definition encode_quot (q : quot s) : nat :=
+encode (rep q)
+
+private definition decode_quot (n : nat) : option (quot s) :=
+match decode A n with
+| some a := some ⟦ a ⟧
+| none   := none
+end
+
+private lemma decode_encode_quot (q : quot s) : decode_quot (encode_quot q) = some q :=
+quot.induction_on q (λ l, begin unfold [encode_quot, decode_quot], rewrite encodek, esimp, rewrite rep_spec end)
+
+definition encodable_quot : encodable (quot s) :=
+encodable.mk
+  encode_quot
+  decode_quot
+  decode_encode_quot
+end
+end quot
+attribute quot.encodable_quot [instance]

old_library/data/equiv.lean

@@ -0,0 +1,411 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+
+In the standard library we cannot assume the univalence axiom.
+We say two types are equivalent if they are isomorphic.
+
+Two equivalent types have the same cardinality.
+-/
+import data.sum data.nat
+open function
+
+structure equiv [class] (A B : Type) :=
+  (to_fun    : A → B)
+  (inv_fun   : B → A)
+  (left_inv  : left_inverse inv_fun to_fun)
+  (right_inv : right_inverse inv_fun to_fun)
+
+namespace equiv
+attribute [reducible]
+definition perm (A : Type) := equiv A A
+
+infix ` ≃ `:50 := equiv
+
+definition fn {A B : Type} (e : equiv A B) : A → B :=
+@equiv.to_fun A B e
+
+infixr ` ∙ `:100 := fn
+
+definition inv {A B : Type} [e : equiv A B] : B → A :=
+@equiv.inv_fun A B e
+
+lemma eq_of_to_fun_eq {A B : Type} : ∀ {e₁ e₂ : equiv A B}, fn e₁ = fn e₂ → e₁ = e₂
+| (mk f₁ g₁ l₁ r₁) (mk f₂ g₂ l₂ r₂) h :=
+  have f₁ = f₂, from h,
+  have g₁ = g₂, from funext (λ x,
+    have f₁ (g₁ x) = f₂ (g₂ x), from eq.trans (r₁ x) (eq.symm (r₂ x)),
+    have f₁ (g₁ x) = f₁ (g₂ x),   begin subst f₂, exact this end,
+    show g₁ x = g₂ x,             from injective_of_left_inverse l₁ this),
+  by congruence; repeat assumption
+
+attribute [refl]
+protected definition refl (A : Type) : A ≃ A :=
+mk (@id A) (@id A) (λ x, rfl) (λ x, rfl)
+
+attribute [symm]
+protected definition symm {A B : Type} : A ≃ B → B ≃ A
+| (mk f g h₁ h₂) := mk g f h₂ h₁
+
+attribute [trans]
+protected definition trans {A B C : Type} : A ≃ B → B ≃ C → A ≃ C
+| (mk f₁ g₁ l₁ r₁) (mk f₂ g₂ l₂ r₂) :=
+  mk (f₂ ∘ f₁) (g₁ ∘ g₂)
+   (show ∀ x, g₁ (g₂ (f₂ (f₁ x))) = x, by intros; rewrite [l₂, l₁]; reflexivity)
+   (show ∀ x, f₂ (f₁ (g₁ (g₂ x))) = x, by intros; rewrite [r₁, r₂]; reflexivity)
+
+abbreviation id {A : Type} := equiv.refl A
+
+namespace ops
+  postfix ⁻¹ := equiv.symm
+  postfix ⁻¹ := equiv.inv
+  notation e₁ ∘ e₂  := equiv.trans e₂ e₁
+end ops
+open equiv.ops
+
+lemma id_apply {A : Type} (x : A) : id ∙ x = x :=
+rfl
+
+lemma comp_apply {A B C : Type} (g : B ≃ C) (f : A ≃ B) (x : A) : (g ∘ f) ∙ x = g ∙ f ∙ x :=
+begin cases g, cases f, esimp end
+
+lemma inverse_apply_apply {A B : Type} : ∀ (e : A ≃ B) (x : A), e⁻¹ ∙ e ∙ x = x
+| (mk f₁ g₁ l₁ r₁) x := begin unfold [equiv.symm, fn], rewrite l₁ end
+
+lemma eq_iff_eq_of_injective {A B : Type} {f : A → B} (inj : injective f) (a b : A) : f a = f b ↔ a = b :=
+iff.intro
+  (suppose f a = f b, inj this)
+  (suppose a = b,     by rewrite this)
+
+lemma apply_eq_iff_eq {A B : Type} : ∀ (f : A ≃ B) (x y : A), f ∙ x = f ∙ y ↔ x = y
+| (mk f₁ g₁ l₁ r₁) x y := eq_iff_eq_of_injective (injective_of_left_inverse l₁) x y
+
+lemma apply_eq_iff_eq_inverse_apply {A B : Type} : ∀ (f : A ≃ B) (x : A) (y : B), f ∙ x = y ↔ x = f⁻¹ ∙ y
+| (mk f₁ g₁ l₁ r₁) x y :=
+  begin
+    esimp, unfold [equiv.symm, fn], apply iff.intro,
+    suppose f₁ x = y, by subst y; rewrite l₁,
+    suppose x = g₁ y, by subst x; rewrite r₁
+  end
+
+definition false_equiv_empty : empty ≃ false :=
+mk (λ e, empty.rec _ e) (λ h, false.rec _ h) (λ e, empty.rec _ e) (λ h, false.rec _ h)
+
+attribute [congr]
+definition arrow_congr {A₁ B₁ A₂ B₂ : Type} : A₁ ≃ A₂ → B₁ ≃ B₂ → (A₁ → B₁) ≃ (A₂ → B₂)
+| (mk f₁ g₁ l₁ r₁) (mk f₂ g₂ l₂ r₂) :=
+  mk
+   (λ (h : A₁ → B₁) (a : A₂), f₂ (h (g₁ a)))
+   (λ (h : A₂ → B₂) (a : A₁), g₂ (h (f₁ a)))
+   (λ h, funext (λ a, by rewrite [l₁, l₂]; reflexivity))
+   (λ h, funext (λ a, by rewrite [r₁, r₂]; reflexivity))
+
+section
+open unit
+attribute [simp]
+definition arrow_unit_equiv_unit (A : Type) : (A → unit) ≃ unit :=
+mk (λ f, star) (λ u, (λ f, star))
+   (λ f, funext (λ x, by cases (f x); reflexivity))
+   (λ u, by cases u; reflexivity)
+
+attribute [simp]
+definition unit_arrow_equiv (A : Type) : (unit → A) ≃ A :=
+mk (λ f, f star) (λ a, (λ u, a))
+   (λ f, funext (λ x, by cases x; reflexivity))
+   (λ u, rfl)
+
+attribute [simp]
+definition empty_arrow_equiv_unit (A : Type) : (empty → A) ≃ unit :=
+mk (λ f, star) (λ u, λ e, empty.rec _ e)
+   (λ f, funext (λ x, empty.rec _ x))
+   (λ u, by cases u; reflexivity)
+
+attribute [simp]
+definition false_arrow_equiv_unit (A : Type) : (false → A) ≃ unit :=
+calc (false → A) ≃ (empty → A) : arrow_congr false_equiv_empty !equiv.refl
+             ... ≃ unit        : empty_arrow_equiv_unit
+end
+
+attribute [congr]
+definition prod_congr {A₁ B₁ A₂ B₂ : Type} : A₁ ≃ A₂ → B₁ ≃ B₂ → (A₁ × B₁) ≃ (A₂ × B₂)
+| (mk f₁ g₁ l₁ r₁) (mk f₂ g₂ l₂ r₂) :=
+  mk
+    (λ p, match p with (a₁, b₁) := (f₁ a₁, f₂ b₁) end)
+    (λ p, match p with (a₂, b₂) := (g₁ a₂, g₂ b₂) end)
+    (λ p, begin cases p, esimp, rewrite [l₁, l₂], reflexivity end)
+    (λ p, begin cases p, esimp, rewrite [r₁, r₂], reflexivity end)
+
+attribute [simp]
+definition prod_comm (A B : Type) : (A × B) ≃ (B × A) :=
+mk (λ p, match p with (a, b) := (b, a) end)
+   (λ p, match p with (b, a) := (a, b) end)
+   (λ p, begin cases p, esimp end)
+   (λ p, begin cases p, esimp end)
+
+attribute [simp]
+definition prod_assoc (A B C : Type) : ((A × B) × C) ≃ (A × (B × C)) :=
+mk (λ t, match t with ((a, b), c) := (a, (b, c)) end)
+   (λ t, match t with (a, (b, c)) := ((a, b), c) end)
+   (λ t, begin cases t with ab c, cases ab, esimp end)
+   (λ t, begin cases t with a bc, cases bc, esimp end)
+
+section
+open unit prod.ops
+attribute [simp]
+definition prod_unit_right (A : Type) : (A × unit) ≃ A :=
+mk (λ p, p.1)
+   (λ a, (a, star))
+   (λ p, begin cases p with a u, cases u, esimp end)
+   (λ a, rfl)
+
+attribute [simp]
+definition prod_unit_left (A : Type) : (unit × A) ≃ A :=
+calc (unit × A) ≃ (A × unit) : prod_comm
+            ... ≃ A          : prod_unit_right
+
+attribute [simp]
+definition prod_empty_right (A : Type) : (A × empty) ≃ empty :=
+mk (λ p, empty.rec _ p.2) (λ e, empty.rec _ e) (λ p, empty.rec _ p.2)  (λ e, empty.rec _ e)
+
+attribute [simp]
+definition prod_empty_left (A : Type) : (empty × A) ≃ empty :=
+calc (empty × A) ≃ (A × empty) : prod_comm
+             ... ≃ empty       : prod_empty_right
+end
+
+section
+open sum
+attribute [congr]
+definition sum_congr {A₁ B₁ A₂ B₂ : Type} : A₁ ≃ A₂ → B₁ ≃ B₂ → (A₁ + B₁) ≃ (A₂ + B₂)
+| (mk f₁ g₁ l₁ r₁) (mk f₂ g₂ l₂ r₂) :=
+  mk
+   (λ s, match s with inl a₁ := inl (f₁ a₁) | inr b₁ := inr (f₂ b₁) end)
+   (λ s, match s with inl a₂ := inl (g₁ a₂) | inr b₂ := inr (g₂ b₂) end)
+   (λ s, begin cases s, {esimp, rewrite l₁, reflexivity}, {esimp, rewrite l₂, reflexivity} end)
+   (λ s, begin cases s, {esimp, rewrite r₁, reflexivity}, {esimp, rewrite r₂, reflexivity} end)
+
+open bool unit
+definition bool_equiv_unit_sum_unit : bool ≃ (unit + unit) :=
+mk (λ b, match b with tt := inl star | ff := inr star end)
+   (λ s, match s with inl star := tt | inr star := ff end)
+   (λ b, begin cases b, esimp, esimp end)
+   (λ s, begin cases s with u u, {cases u, esimp}, {cases u, esimp} end)
+
+attribute [simp]
+definition sum_comm (A B : Type) : (A + B) ≃ (B + A) :=
+mk (λ s, match s with inl a := inr a | inr b := inl b end)
+   (λ s, match s with inl b := inr b | inr a := inl a end)
+   (λ s, begin cases s, esimp, esimp end)
+   (λ s, begin cases s, esimp, esimp end)
+
+attribute [simp]
+definition sum_assoc (A B C : Type) : ((A + B) + C) ≃ (A + (B + C)) :=
+mk (λ s, match s with inl (inl a) := inl a | inl (inr b) := inr (inl b) | inr c := inr (inr c) end)
+   (λ s, match s with inl a := inl (inl a) | inr (inl b) := inl (inr b) | inr (inr c) := inr c end)
+   (λ s, begin cases s with ab c, cases ab, repeat esimp end)
+   (λ s, begin cases s with a bc, esimp, cases bc, repeat esimp end)
+
+attribute [simp]
+definition sum_empty_right (A : Type) : (A + empty) ≃ A :=
+mk (λ s, match s with inl a := a | inr e := empty.rec _ e end)
+   (λ a, inl a)
+   (λ s, begin cases s with a e, esimp, exact empty.rec _ e end)
+   (λ a, rfl)
+
+attribute [simp]
+definition sum_empty_left (A : Type) : (empty + A) ≃ A :=
+calc (empty + A) ≃ (A + empty) : sum_comm
+          ...    ≃ A           : sum_empty_right
+end
+
+section
+open prod.ops
+definition arrow_prod_equiv_prod_arrow (A B C : Type) : (C → A × B) ≃ ((C → A) × (C → B)) :=
+mk (λ f, (λ c, (f c).1, λ c, (f c).2))
+   (λ p, λ c, (p.1 c, p.2 c))
+   (λ f, funext (λ c, begin esimp, cases f c, esimp end))
+   (λ p, begin cases p, esimp end)
+
+definition arrow_arrow_equiv_prod_arrow (A B C : Type) : (A → B → C) ≃ (A × B → C) :=
+mk (λ f, λ p, f p.1 p.2)
+   (λ f, λ a b, f (a, b))
+   (λ f, rfl)
+   (λ f, funext (λ p, begin cases p, esimp end))
+
+open sum
+definition sum_arrow_equiv_prod_arrow (A B C : Type) : ((A + B) → C) ≃ ((A → C) × (B → C)) :=
+mk (λ f, (λ a, f (inl a), λ b, f (inr b)))
+   (λ p, (λ s, match s with inl a := p.1 a | inr b := p.2 b end))
+   (λ f, funext (λ s, begin cases s, esimp, esimp end))
+   (λ p, begin cases p, esimp end)
+
+definition sum_prod_distrib (A B C : Type) : ((A + B) × C) ≃ ((A × C) + (B × C)) :=
+mk (λ p, match p with (inl a, c) := inl (a, c) | (inr b, c) := inr (b, c) end)
+   (λ s, match s with inl (a, c) := (inl a, c) | inr (b, c) := (inr b, c) end)
+   (λ p, begin cases p with ab c, cases ab, repeat esimp end)
+   (λ s, begin cases s with ac bc, cases ac, esimp, cases bc, esimp end)
+
+definition prod_sum_distrib (A B C : Type) : (A × (B + C)) ≃ ((A × B) + (A × C)) :=
+calc (A × (B + C)) ≃ ((B + C) × A)       : prod_comm
+             ...   ≃ ((B × A) + (C × A)) : sum_prod_distrib
+             ...   ≃ ((A × B) + (A × C)) : sum_congr !prod_comm !prod_comm
+
+definition bool_prod_equiv_sum (A : Type) : (bool × A) ≃ (A + A) :=
+calc (bool × A) ≃ ((unit + unit) × A)       : prod_congr bool_equiv_unit_sum_unit !equiv.refl
+        ...     ≃ (A × (unit + unit))       : prod_comm
+        ...     ≃ ((A × unit) + (A × unit)) : prod_sum_distrib
+        ...     ≃ (A + A)                   : sum_congr !prod_unit_right !prod_unit_right
+end
+
+section
+open sum nat unit prod.ops
+definition nat_equiv_nat_sum_unit : nat ≃ (nat + unit) :=
+mk (λ n, match n with zero := inr star | succ a := inl a end)
+   (λ s, match s with inl n := succ n | inr star := zero end)
+   (λ n, begin cases n, repeat esimp end)
+   (λ s, begin cases s with a u, esimp, {cases u, esimp} end)
+
+attribute [simp]
+definition nat_sum_unit_equiv_nat : (nat + unit) ≃ nat :=
+equiv.symm nat_equiv_nat_sum_unit
+
+attribute [simp]
+definition nat_prod_nat_equiv_nat : (nat × nat) ≃ nat :=
+mk (λ p, mkpair p.1 p.2)
+   (λ n, unpair n)
+   (λ p, begin cases p, apply unpair_mkpair end)
+   (λ n, mkpair_unpair n)
+
+attribute [simp]
+definition nat_sum_bool_equiv_nat : (nat + bool) ≃ nat :=
+calc (nat + bool) ≃ (nat + (unit + unit)) : sum_congr !equiv.refl bool_equiv_unit_sum_unit
+             ...  ≃ ((nat + unit) + unit) : sum_assoc
+             ...  ≃ (nat + unit)          : sum_congr nat_sum_unit_equiv_nat !equiv.refl
+             ...  ≃ nat                   : nat_sum_unit_equiv_nat
+
+open decidable
+attribute [simp]
+definition nat_sum_nat_equiv_nat : (nat + nat) ≃ nat :=
+mk (λ s, match s with inl n := 2*n | inr n := 2*n+1 end)
+   (λ n, if even n then inl (n / 2) else inr ((n - 1) / 2))
+   (λ s, begin
+           have two_gt_0 : 2 > zero, from dec_trivial,
+           cases s,
+             {esimp, rewrite [if_pos (even_two_mul _), nat.mul_div_cancel_left _ two_gt_0]},
+             {esimp, rewrite [if_neg (not_even_two_mul_plus_one _), nat.add_sub_cancel,
+                              nat.mul_div_cancel_left _ two_gt_0]}
+         end)
+   (λ n, by_cases
+          (λ h : even n,
+            by rewrite [if_pos h]; esimp; rewrite [nat.mul_div_cancel' (dvd_of_even h)])
+          (λ h : ¬ even n,
+            begin
+              rewrite [if_neg h], esimp,
+              cases n,
+                {exact absurd even_zero h},
+                {rewrite [-(add_one a), nat.add_sub_cancel,
+                          nat.mul_div_cancel' (dvd_of_even (even_of_odd_succ (odd_of_not_even h)))]}
+            end))
+
+definition prod_equiv_of_equiv_nat {A : Type} : A ≃ nat → (A × A) ≃ A :=
+take e, calc
+  (A × A) ≃ (nat × nat) : prod_congr e e
+     ...  ≃ nat         : nat_prod_nat_equiv_nat
+     ...  ≃ A           : equiv.symm e
+end
+
+section
+open decidable
+definition decidable_eq_of_equiv {A B : Type} [h : decidable_eq A] : A ≃ B → decidable_eq B
+| (mk f g l r) :=
+  take b₁ b₂, match h (g b₁) (g b₂) with
+  | inl he := inl (have aux : f (g b₁) = f (g b₂), from congr_arg f he,
+                   begin rewrite *r at aux, exact aux end)
+  | inr hn := inr (λ b₁eqb₂, by subst b₁eqb₂; exact absurd rfl hn)
+  end
+end
+
+definition inhabited_of_equiv {A B : Type} [h : inhabited A] : A ≃ B → inhabited B
+| (mk f g l r) := inhabited.mk (f (inhabited.value h))
+
+section
+open subtype
+definition subtype_equiv_of_subtype {A B : Type} {p : A → Prop} : A ≃ B → {a : A | p a} ≃ {b : B | p b⁻¹}
+| (mk f g l r) :=
+  mk (λ s, match s with tag v h := tag (f v) (eq.rec_on (eq.symm (l v)) h) end)
+     (λ s, match s with tag v h := tag (g v) (eq.rec_on (eq.symm (r v)) h) end)
+     (λ s, begin cases s, esimp, congruence, rewrite l, reflexivity end)
+     (λ s, begin cases s, esimp, congruence, rewrite r, reflexivity end)
+end
+
+section swap
+variable {A : Type}
+variable [h : decidable_eq A]
+include h
+open decidable
+
+definition swap_core (a b r : A) : A :=
+if r = a then b
+else if r = b then a
+else r
+
+lemma swap_core_swap_core (r a b : A) : swap_core a b (swap_core a b r) = r :=
+by_cases
+  (suppose r = a, by_cases
+    (suppose r = b,   begin unfold swap_core, rewrite [if_pos `r = a`, if_pos (eq.refl b), -`r = a`, -`r = b`, if_pos (eq.refl r)] end)
+    (suppose ¬ r = b,
+      have b ≠ a, from assume h, begin rewrite h at this, contradiction end,
+      begin unfold swap_core, rewrite [*if_pos `r = a`, if_pos (eq.refl b), if_neg `b ≠ a`, `r = a`] end))
+  (suppose ¬ r = a, by_cases
+    (suppose r = b,   begin unfold swap_core, rewrite [if_neg `¬ r = a`, *if_pos `r = b`, if_pos (eq.refl a), this] end)
+    (suppose ¬ r = b, begin unfold swap_core, rewrite [*if_neg `¬ r = a`, *if_neg `¬ r = b`, if_neg `¬ r = a`] end))
+
+lemma swap_core_self (r a : A) : swap_core a a r = r :=
+by_cases
+  (suppose r = a, begin unfold swap_core, rewrite [*if_pos this, this] end)
+  (suppose r ≠ a, begin unfold swap_core, rewrite [*if_neg this] end)
+
+lemma swap_core_comm (r a b : A) : swap_core a b r = swap_core b a r :=
+by_cases
+  (suppose r = a, by_cases
+    (suppose r = b,   begin unfold swap_core, rewrite [if_pos `r = a`, if_pos `r = b`, -`r = a`, -`r = b`] end)
+    (suppose ¬ r = b, begin unfold swap_core, rewrite [*if_pos `r = a`, if_neg `¬ r = b`] end))
+  (suppose ¬ r = a, by_cases
+    (suppose r = b,   begin unfold swap_core, rewrite [if_neg `¬ r = a`, *if_pos `r = b`]    end)
+    (suppose ¬ r = b, begin unfold swap_core, rewrite [*if_neg `¬ r = a`, *if_neg `¬ r = b`] end))
+
+definition swap (a b : A) : perm A :=
+mk (swap_core a b)
+   (swap_core a b)
+   (λ x, abstract by rewrite swap_core_swap_core end)
+   (λ x, abstract by rewrite swap_core_swap_core end)
+
+lemma swap_self (a : A) : swap a a = id :=
+eq_of_to_fun_eq (funext (λ x, begin unfold [swap, fn], rewrite swap_core_self end))
+
+lemma swap_comm (a b : A) : swap a b = swap b a :=
+eq_of_to_fun_eq (funext (λ x, begin unfold [swap, fn], rewrite swap_core_comm end))
+
+lemma swap_apply_def (a b : A) (x : A) : swap a b ∙ x = if x = a then b else if x = b then a else x :=
+rfl
+
+lemma swap_apply_left (a b : A) : swap a b ∙ a = b :=
+if_pos rfl
+
+lemma swap_apply_right (a b : A) : swap a b ∙ b = a :=
+by_cases
+  (suppose b = a, by rewrite [swap_apply_def, this, *if_pos rfl])
+  (suppose b ≠ a, by rewrite [swap_apply_def, if_pos rfl, if_neg this])
+
+lemma swap_apply_of_ne_of_ne {a b : A} {x : A} : x ≠ a → x ≠ b → swap a b ∙ x = x :=
+assume h₁ h₂, by rewrite [swap_apply_def, if_neg h₁, if_neg h₂]
+
+lemma swap_swap (a b : A) : swap a b ∘ swap a b = id :=
+eq_of_to_fun_eq (funext (λ x, begin unfold [swap, fn, equiv.trans, equiv.refl], rewrite swap_core_swap_core end))
+
+lemma swap_comp_apply (a b : A) (π : perm A) (x : A) : (swap a b ∘ π) ∙ x = if π ∙ x = a then b else if π ∙ x = b then a else π ∙ x :=
+begin cases π, reflexivity end
+
+end swap
+end equiv

old_library/data/examples/depchoice.lean

@@ -0,0 +1,81 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+-/
+import data.encodable
+open nat encodable
+
+/-
+In mathematics, the axiom of dependent choice is a weak form of the axiom of choice that is
+sufficient to develop most of real analysis. See http://en.wikipedia.org/wiki/Axiom_of_dependent_choice.
+We can state it as follows:
+-/
+definition dependent_choice {A : Type} (R : A → A → Prop) :=
+(∀ a : A, ∃ b : A, R a b) → (∀ a : A, ∃ f : nat → A, f 0 = a ∧ ∀ n, R (f n) (f (n+1)))
+
+/-
+If A is an encodable type, and R is a decidable relation, we can prove (dependent_choice R) using the
+constructive choice function "choose"
+-/
+section depchoice
+  parameters {A : Type} {R : A → A → Prop}
+  parameters [encA : encodable A] [decR : decidable_rel R]
+  include encA decR
+
+  local infix `~` := R
+
+  private definition f_aux (a : A) (H : ∀ a, ∃ b, a ~ b) : nat → A
+  | 0     := a
+  | (n+1) := choose (H (f_aux n))
+
+  theorem dependent_choice_of_encodable_of_decidable : dependent_choice R :=
+  assume H : ∀ a, ∃ b, a ~ b,
+  take   a : A,
+  let    f : nat → A := f_aux a H in
+  have   f_zero : f 0 = a,            from rfl,
+  have   R_seq  : ∀ n, f n ~ f (n+1), from
+    take n, show f n ~ choose (H (f n)), from !choose_spec,
+  exists.intro f (and.intro f_zero R_seq)
+
+  /-
+  The following slightly stronger version can be proved, where we also "return" the constructed function f.
+  We just have to use Σ instead of ∃, and use Σ-constructor instead of exists.intro.
+  Recall that ⟨f, H⟩ is notation for (sigma.mk f H)
+  -/
+  theorem stronger_dependent_choice_of_encodable_of_decidable
+          : (∀ a, ∃ b, R a b) → (∀ a, Σ f, f (0:nat) = a ∧ ∀ n, f n ~ f (n+1))  :=
+  assume H : ∀ a, ∃ b, a ~ b,
+  take   a : A,
+  let    f : nat → A := f_aux a H in
+  have   f_zero : f 0 = a,            from rfl,
+  have   R_seq  : ∀ n, f n ~ f (n+1), from
+    take n, show f n ~ choose (H (f n)), from !choose_spec,
+  ⟨f, and.intro f_zero R_seq⟩
+
+end depchoice
+
+/-
+If we encode dependent_choice using Σ instead of ∃.
+Then, we can prove this version without using any extra hypothesis (e.g., A is encodable or R is decidable).
+The function f can be constructed directly from the hypothesis: ∀ a : A, Σ b : A, R a b
+because Σ "carries" the witness 'b'. That is, we don't have to search for anything using "choose".
+-/
+open sigma.ops
+
+section sigma_depchoice
+  parameters {A : Type} {R : A → A → Prop}
+  local infix `~` := R
+
+  private definition f_aux (a : A) (H : ∀ a, Σ b, a ~ b) : nat → A
+  | 0     := a
+  | (n+1) := (H (f_aux n)).1
+
+  theorem sigma_dependent_choice : (∀ a, Σ b, R a b) → (∀ a, Σ f, f (0:nat) = a ∧ ∀ n, f n ~ f (n+1)) :=
+  assume H : ∀ a, Σ b, a ~ b,
+  take   a : A,
+  let    f : nat → A := f_aux a H in
+  have   f_zero : f 0 = a,            from rfl,
+  have   R_seq  : ∀ n, f n ~ f (n+1), from take n, (H (f n)).2,
+  ⟨f, and.intro f_zero R_seq⟩
+end sigma_depchoice

old_library/data/examples/notencodable.lean

@@ -0,0 +1,43 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+
+Small example showing that (nat → nat) is not encodable.
+-/
+import data.encodable
+open nat encodable option
+
+section
+hypothesis nat_nat_encodable : encodable (nat → nat)
+
+private definition decode_fun (n : nat) : option (nat → nat) :=
+@decode (nat → nat) nat_nat_encodable n
+
+private definition encode_fun (f : nat → nat) : nat :=
+@encode (nat → nat) nat_nat_encodable f
+
+private lemma encodek_fun : ∀ f : nat → nat, decode_fun (encode_fun f) = some f :=
+λ f, !encodek
+
+private definition f (n : nat) : nat :=
+match decode_fun n with
+| some g := succ (g n)
+| none   := 0
+end
+
+private definition v : nat := encode_fun f
+
+private lemma f_eq : succ (f v) = f v :=
+begin
+  change succ (f v) =
+         match decode_fun (encode_fun f) with
+         | some g := succ (g v)
+         | none   := 0
+         end,
+  rewrite encodek_fun
+end
+end
+
+theorem not_encodable_nat_arrow_nat : (encodable (nat → nat)) → false :=
+assume h, absurd (f_eq h) succ_ne_self

old_library/data/examples/vector.lean

@@ -0,0 +1,345 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Floris van Doorn, Leonardo de Moura
+
+This file demonstrates how to encode vectors using indexed inductive families.
+In standard library we do not use this approach.
+-/
+import data.nat data.list data.fin
+open nat prod fin
+
+inductive vector (A : Type) : nat → Type :=
+| nil {} : vector A zero
+| cons   : Π {n}, A → vector A n → vector A (succ n)
+
+namespace vector
+  notation a :: b := cons a b
+  notation `[` l:(foldr `, ` (h t, cons h t) nil `]`) := l
+
+  variables {A B C : Type}
+
+  attribute [instance]
+  protected definition is_inhabited [h : inhabited A] : ∀ (n : nat), inhabited (vector A n)
+  | 0     := inhabited.mk []
+  | (n+1) := inhabited.mk (inhabited.value h :: inhabited.value (is_inhabited n))
+
+  theorem vector0_eq_nil : ∀ (v : vector A 0), v = []
+  | [] := rfl
+
+  definition head : Π {n : nat}, vector A (succ n) → A
+  | n (a::v) := a
+
+  definition tail : Π {n : nat}, vector A (succ n) → vector A n
+  | n (a::v) := v
+
+  theorem head_cons {n : nat} (h : A) (t : vector A n) : head (h :: t) = h :=
+  rfl
+
+  theorem tail_cons {n : nat} (h : A) (t : vector A n) : tail (h :: t) = t :=
+  rfl
+
+  theorem eta : ∀ {n : nat} (v : vector A (succ n)), head v :: tail v = v
+  | n (a::v) := rfl
+
+  definition last : Π {n : nat}, vector A (succ n) → A
+  | last [a]    := a
+  | last (a::v) := last v
+
+  theorem last_singleton (a : A) : last [a] = a :=
+  rfl
+
+  theorem last_cons {n : nat} (a : A) (v : vector A (succ n)) : last (a :: v) = last v :=
+  rfl
+
+  definition const : Π (n : nat), A → vector A n
+  | 0        a := []
+  | (succ n) a := a :: const n a
+
+  theorem head_const (n : nat) (a : A) : head (const (succ n) a) = a :=
+  rfl
+
+  theorem last_const : ∀ (n : nat) (a : A), last (const (succ n) a) = a
+  | 0     a := rfl
+  | (n+1) a := last_const n a
+
+  definition nth : Π {n : nat}, vector A n → fin n → A
+  | ⌞0⌟   []       i               := elim0 i
+  | ⌞n+1⌟ (a :: v) (mk 0 _)        := a
+  | ⌞n+1⌟ (a :: v) (mk (succ i) h) := nth v (mk_pred i h)
+
+  lemma nth_zero {n : nat} (a : A) (v : vector A n) (h : 0 < succ n) : nth (a::v) (mk 0 h) = a :=
+  rfl
+
+  lemma nth_succ {n : nat} (a : A) (v : vector A n) (i : nat) (h : succ i < succ n)
+                 : nth (a::v) (mk (succ i) h) = nth v (mk_pred i h) :=
+  rfl
+
+  definition tabulate : Π {n : nat}, (fin n → A) → vector A n
+  | 0      f :=  []
+  | (n+1)  f :=  f (fin.zero n) :: tabulate (λ i : fin n, f (succ i))
+
+  theorem nth_tabulate : ∀ {n : nat} (f : fin n → A) (i : fin n), nth (tabulate f) i = f i
+  | 0     f i               := elim0 i
+  | (n+1) f (mk 0 h)        := by reflexivity
+  | (n+1) f (mk (succ i) h) :=
+    begin
+      change nth (f (fin.zero n) :: tabulate (λ i : fin n, f (succ i))) (mk (succ i) h) = f (mk (succ i) h),
+      rewrite nth_succ,
+      rewrite nth_tabulate
+    end
+
+  definition map (f : A → B) : Π {n : nat}, vector A n → vector B n
+  | map []     := []
+  | map (a::v) := f a :: map v
+
+  theorem map_nil (f : A → B) : map f [] = [] :=
+  rfl
+
+  theorem map_cons {n : nat} (f : A → B) (h : A) (t : vector A n) : map f (h :: t) =  f h :: map f t :=
+  rfl
+
+  theorem nth_map (f : A → B) : ∀ {n : nat} (v : vector A n) (i : fin n), nth (map f v) i = f (nth v i)
+  | 0        v        i               := elim0 i
+  | (succ n) (a :: t) (mk 0 h)        := by reflexivity
+  | (succ n) (a :: t) (mk (succ i) h) := by rewrite [map_cons, *nth_succ, nth_map]
+
+  section
+  open function
+  theorem map_id : ∀ {n : nat} (v : vector A n), map id v = v
+  | 0        []      := rfl
+  | (succ n) (x::xs) := by rewrite [map_cons, map_id]
+
+  theorem map_map (g : B → C) (f : A → B) : ∀ {n :nat} (v : vector A n), map g (map f v) = map (g ∘ f) v
+  | 0        []       := rfl
+  | (succ n) (a :: l) :=
+    show (g ∘ f) a :: map g (map f l) = map (g ∘ f) (a :: l),
+    by rewrite (map_map l)
+  end
+
+  definition map2 (f : A → B → C) : Π {n : nat}, vector A n → vector B n → vector C n
+  | map2 []      []      := []
+  | map2 (a::va) (b::vb) := f a b :: map2 va vb
+
+  theorem map2_nil (f : A → B → C) : map2 f [] [] = [] :=
+  rfl
+
+  theorem map2_cons {n : nat} (f : A → B → C) (h₁ : A) (h₂ : B) (t₁ : vector A n) (t₂ : vector B n) :
+                    map2 f (h₁ :: t₁) (h₂ :: t₂) = f h₁ h₂ :: map2 f t₁ t₂ :=
+  rfl
+
+  definition append : Π {n m : nat}, vector A n → vector A m → vector A (n ⊕ m)
+  | 0        m []     w := w
+  | (succ n) m (a::v) w := a :: (append v w)
+
+  theorem append_nil_left {n : nat} (v : vector A n) : append [] v = v :=
+  rfl
+
+  theorem append_cons {n m : nat} (h : A) (t : vector A n) (v : vector A m) :
+    append (h::t) v = h :: (append t v) :=
+  rfl
+
+  theorem map_append (f : A → B) : ∀ {n m : nat} (v : vector A n) (w : vector A m), map f (append v w) = append (map f v) (map f w)
+  | 0     m   []        w   :=  rfl
+  | (n+1) m   (h :: t)  w   :=
+     begin
+       change (f h :: map f (append t w) = f h :: append (map f t) (map f w)),
+       rewrite map_append
+     end
+
+  definition unzip : Π {n : nat}, vector (A × B) n → vector A n × vector B n
+  | unzip []            := ([], [])
+  | unzip ((a, b) :: v) := (a :: pr₁ (unzip v), b :: pr₂ (unzip v))
+
+  theorem unzip_nil : unzip (@nil (A × B)) = ([], []) :=
+  rfl
+
+  theorem unzip_cons {n : nat} (a : A) (b : B) (v : vector (A × B) n) :
+       unzip ((a, b) :: v) = (a :: pr₁ (unzip v), b :: pr₂ (unzip v)) :=
+  rfl
+
+  definition zip : Π {n : nat}, vector A n → vector B n → vector (A × B) n
+  | zip []      []      := []
+  | zip (a::va) (b::vb) := ((a, b) :: zip va vb)
+
+  theorem zip_nil_nil : zip (@nil A) (@nil B) = nil :=
+  rfl
+
+  theorem zip_cons_cons {n : nat} (a : A) (b : B) (va : vector A n) (vb : vector B n) :
+      zip (a::va) (b::vb) = ((a, b) :: zip va vb) :=
+  rfl
+
+  theorem unzip_zip : ∀ {n : nat} (v₁ : vector A n) (v₂ : vector B n), unzip (zip v₁ v₂) = (v₁, v₂)
+  | 0     []      []      := rfl
+  | (n+1) (a::va) (b::vb) := calc
+       unzip (zip (a :: va) (b :: vb))
+             = (a :: pr₁ (unzip (zip va vb)), b :: pr₂ (unzip (zip va vb))) : rfl
+        ...  = (a :: pr₁ (va, vb), b :: pr₂ (va, vb))                       : by rewrite unzip_zip
+        ...  = (a :: va, b :: vb)                                           : rfl
+
+  theorem zip_unzip : ∀ {n : nat} (v : vector (A × B) n), zip (pr₁ (unzip v)) (pr₂ (unzip v)) = v
+  | 0     []             := rfl
+  | (n+1) ((a, b) :: v)  := calc
+    zip (pr₁ (unzip ((a, b) :: v))) (pr₂ (unzip ((a, b) :: v)))
+         = (a, b) :: zip (pr₁ (unzip v)) (pr₂ (unzip v)) : rfl
+     ... = (a, b) :: v                                   : by rewrite zip_unzip
+
+  /- Concat -/
+
+  definition concat : Π {n : nat}, vector A n → A → vector A (succ n)
+  | concat []     a := [a]
+  | concat (b::v) a := b :: concat v a
+
+  theorem concat_nil (a : A) : concat [] a = [a] :=
+  rfl
+
+  theorem concat_cons {n : nat} (b : A) (v : vector A n) (a : A) : concat (b :: v) a = b :: concat v a :=
+  rfl
+
+  theorem last_concat : ∀ {n : nat} (v : vector A n) (a : A), last (concat v a) = a
+  | 0     []     a := rfl
+  | (n+1) (b::v) a := calc
+    last (concat (b::v) a) = last (concat v a) : rfl
+                    ...    = a                 : last_concat v a
+
+  /- Reverse -/
+
+  definition reverse : Π {n : nat}, vector A n → vector A n
+  | 0     []        := []
+  | (n+1) (x :: xs) := concat (reverse xs) x
+
+  theorem reverse_concat : Π {n : nat} (xs : vector A n) (a : A), reverse (concat xs a) = a :: reverse xs
+  | 0     []         a := rfl
+  | (n+1) (x :: xs)  a :=
+    begin
+      change (concat (reverse (concat xs a)) x = a :: reverse (x :: xs)),
+      rewrite reverse_concat
+    end
+
+  theorem reverse_reverse : Π {n : nat} (xs : vector A n), reverse (reverse xs) = xs
+  | 0     []        := rfl
+  | (n+1) (x :: xs) :=
+    begin
+      change (reverse (concat (reverse xs) x) = x :: xs),
+      rewrite [reverse_concat, reverse_reverse]
+    end
+
+  /- list <-> vector -/
+
+  definition of_list : Π (l : list A), vector A (list.length l)
+  | list.nil        := []
+  | (list.cons a l) := a :: (of_list l)
+
+  definition to_list : Π {n : nat}, vector A n → list A
+  | 0     []        := list.nil
+  | (n+1) (a :: vs) := list.cons a (to_list vs)
+
+  theorem to_list_of_list : ∀ (l : list A), to_list (of_list l) = l
+  | list.nil         := rfl
+  | (list.cons a l)  :=
+    begin
+      change (list.cons a (to_list (of_list l)) = list.cons a l),
+      rewrite to_list_of_list
+    end
+
+  theorem to_list_nil : to_list [] = (list.nil : list A) :=
+  rfl
+
+  theorem length_to_list : ∀ {n : nat} (v : vector A n), list.length (to_list v) = n
+  | 0     []        := rfl
+  | (n+1) (a :: vs) :=
+    begin
+      change (succ (list.length (to_list vs)) = succ n),
+      rewrite length_to_list
+    end
+
+  theorem heq_of_list_eq : ∀ {n m} {v₁ : vector A n} {v₂ : vector A m}, to_list v₁ = to_list v₂ → n = m → v₁ == v₂
+  | 0     0     []      []      h₁ h₂ := !heq.refl
+  | 0     (m+1) []      (y::ys) h₁ h₂ := by contradiction
+  | (n+1) 0     (x::xs) []      h₁ h₂ := by contradiction
+  | (n+1) (m+1) (x::xs) (y::ys) h₁ h₂ :=
+    have e₁ : n = m, from succ.inj h₂,
+    have e₂ : x = y, begin unfold to_list at h₁, injection h₁, assumption end,
+    have   e₃ : to_list xs = to_list ys, begin unfold to_list at h₁, injection h₁, assumption end,
+    have xs == ys, from heq_of_list_eq e₃ e₁,
+    have y :: xs == y :: ys, begin clear heq_of_list_eq h₁ h₂ e₃, revert xs ys this, induction e₁, intro xs ys h, rewrite [eq_of_heq h] end,
+    show x :: xs == y :: ys, by rewrite e₂; exact this
+
+  theorem list_eq_of_heq {n m} {v₁ : vector A n} {v₂ : vector A m} : v₁ == v₂ → n = m → to_list v₁ = to_list v₂ :=
+  begin
+    intro h₁ h₂, revert v₁ v₂ h₁,
+    subst n, intro v₁ v₂ h₁, rewrite [eq_of_heq h₁]
+  end
+
+  theorem of_list_to_list {n : nat} (v : vector A n) : of_list (to_list v) == v :=
+  begin
+    apply heq_of_list_eq, rewrite to_list_of_list, rewrite length_to_list
+  end
+
+  theorem to_list_append : ∀ {n m : nat} (v₁ : vector A n) (v₂ : vector A m), to_list (append v₁ v₂) = list.append (to_list v₁) (to_list v₂)
+  | 0        m        []      ys      := rfl
+  | (succ n) m        (x::xs) ys      := begin unfold append, unfold to_list at {1,2}, krewrite [to_list_append xs ys] end
+
+  theorem to_list_map (f : A → B) : ∀ {n : nat} (v : vector A n), to_list (map f v) = list.map f (to_list v)
+  | 0        []      := rfl
+  | (succ n) (x::xs) := begin unfold [map, to_list], rewrite to_list_map end
+
+  theorem to_list_concat : ∀ {n : nat} (v : vector A n) (a : A), to_list (concat v a) = list.concat a (to_list v)
+  | 0        []      a := rfl
+  | (succ n) (x::xs) a := begin unfold [concat, to_list], rewrite to_list_concat end
+
+  theorem to_list_reverse : ∀ {n : nat} (v : vector A n), to_list (reverse v) = list.reverse (to_list v)
+  | 0        []      := rfl
+  | (succ n) (x::xs) := begin unfold [reverse], rewrite [to_list_concat, to_list_reverse] end
+
+  theorem append_nil_right {n : nat} (v : vector A n) : append v [] == v :=
+  begin
+    apply heq_of_list_eq,
+      rewrite [to_list_append, to_list_nil, list.append_nil_right],
+      rewrite [-add_eq_addl]
+  end
+
+  theorem append.assoc {n₁ n₂ n₃ : nat} (v₁ : vector A n₁) (v₂ : vector A n₂) (v₃ : vector A n₃) : append v₁ (append v₂ v₃) == append (append v₁ v₂) v₃ :=
+  begin
+    apply heq_of_list_eq,
+      rewrite [*to_list_append, list.append.assoc],
+      rewrite [-*add_eq_addl, add.assoc]
+  end
+
+  theorem reverse_append {n m : nat} (v : vector A n) (w : vector A m) : reverse (append v w) == append (reverse w) (reverse v) :=
+  begin
+    apply heq_of_list_eq,
+      rewrite [to_list_reverse, to_list_append, list.reverse_append, to_list_append, *to_list_reverse],
+      rewrite [-*add_eq_addl, add.comm]
+  end
+
+  theorem concat_eq_append {n : nat} (v : vector A n) (a : A) : concat v a == append v [a] :=
+  begin
+    apply heq_of_list_eq,
+      rewrite [to_list_concat, to_list_append, list.concat_eq_append],
+      rewrite [-add_eq_addl]
+  end
+
+  /- decidable equality -/
+  open decidable
+  definition decidable_eq [H : decidable_eq A] : ∀ {n : nat} (v₁ v₂ : vector A n), decidable (v₁ = v₂)
+  | ⌞0⌟    []      []      := by left; reflexivity
+  | ⌞n+1⌟  (a::v₁) (b::v₂) :=
+    match H a b with
+    | inl Hab  :=
+      match decidable_eq v₁ v₂ with
+      | inl He := by left; congruence; repeat assumption
+      | inr Hn := by right; intro h; injection h; contradiction
+      end
+    | inr Hnab := by right; intro h; injection h; contradiction
+  end
+
+  section
+  open equiv function
+  definition vector_equiv_of_equiv {A B : Type} : A ≃ B → ∀ n, vector A n ≃ vector B n
+  | (mk f g l r) n :=
+    mk (map f) (map g)
+     begin intros, rewrite [map_map, id_of_left_inverse l, map_id], reflexivity end
+     begin intros, rewrite [map_map, id_of_right_inverse r, map_id], reflexivity end
+  end
+end vector

old_library/data/finset/basic.lean

@@ -0,0 +1,740 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura, Jeremy Avigad
+
+Finite sets.
+-/
+import data.fintype.basic data.nat data.list.perm algebra.binary
+open nat quot list subtype binary function eq.ops
+open [decl] perm
+
+definition nodup_list (A : Type) := {l : list A | nodup l}
+
+variable {A : Type}
+
+definition to_nodup_list_of_nodup {l : list A} (n : nodup l) : nodup_list A :=
+tag l n
+
+definition to_nodup_list [decidable_eq A] (l : list A) : nodup_list A :=
+@to_nodup_list_of_nodup A (erase_dup l) (nodup_erase_dup l)
+
+private definition eqv (l₁ l₂ : nodup_list A) :=
+perm (elt_of l₁) (elt_of l₂)
+
+local infix ~ := eqv
+
+private definition eqv.refl (l : nodup_list A) : l ~ l :=
+!perm.refl
+
+private definition eqv.symm {l₁ l₂ : nodup_list A} : l₁ ~ l₂ → l₂ ~ l₁ :=
+perm.symm
+
+private definition eqv.trans {l₁ l₂ l₃ : nodup_list A} : l₁ ~ l₂ → l₂ ~ l₃ → l₁ ~ l₃ :=
+perm.trans
+
+attribute [instance]
+definition finset.nodup_list_setoid (A : Type) : setoid (nodup_list A) :=
+setoid.mk (@eqv A) (mk_equivalence (@eqv A) (@eqv.refl A) (@eqv.symm A) (@eqv.trans A))
+
+definition finset (A : Type) : Type :=
+quot (finset.nodup_list_setoid A)
+
+namespace finset
+
+-- give finset notation higher priority than set notation, so that it is tried first
+protected definition prio : num := num.succ std.priority.default
+
+definition to_finset_of_nodup (l : list A) (n : nodup l) : finset A :=
+⟦to_nodup_list_of_nodup n⟧
+
+definition to_finset [decidable_eq A] (l : list A) : finset A :=
+⟦to_nodup_list l⟧
+
+lemma to_finset_eq_of_nodup [decidable_eq A] {l : list A} (n : nodup l) :
+  to_finset_of_nodup l n = to_finset l :=
+have P : to_nodup_list_of_nodup n = to_nodup_list l, from
+  begin
+    rewrite [↑to_nodup_list, ↑to_nodup_list_of_nodup],
+    congruence,
+    rewrite [erase_dup_eq_of_nodup n]
+  end,
+quot.sound (eq.subst P !setoid.refl)
+
+attribute [instance]
+definition has_decidable_eq [decidable_eq A] : decidable_eq (finset A) :=
+λ s₁ s₂, quot.rec_on_subsingleton₂ s₁ s₂
+  (λ l₁ l₂,
+     match decidable_perm (elt_of l₁) (elt_of l₂) with
+     | decidable.inl e := decidable.inl (quot.sound e)
+     | decidable.inr n := decidable.inr (λ e : ⟦l₁⟧ = ⟦l₂⟧, absurd (quot.exact e) n)
+     end)
+
+definition mem (a : A) (s : finset A) : Prop :=
+quot.lift_on s (λ l, a ∈ elt_of l)
+ (λ l₁ l₂ (e : l₁ ~ l₂), propext (iff.intro
+   (λ ainl₁, mem_perm e ainl₁)
+   (λ ainl₂, mem_perm (perm.symm e) ainl₂)))
+
+infix [priority finset.prio] ∈ := mem
+notation [priority finset.prio] a ∉ b := ¬ mem a b
+
+theorem mem_of_mem_list {a : A} {l : nodup_list A} : a ∈ elt_of l → a ∈ ⟦l⟧ :=
+λ ainl, ainl
+
+theorem mem_list_of_mem {a : A} {l : nodup_list A} : a ∈ ⟦l⟧ → a ∈ elt_of l :=
+λ ainl, ainl
+
+attribute [instance]
+definition decidable_mem [h : decidable_eq A] : ∀ (a : A) (s : finset A), decidable (a ∈ s) :=
+λ a s, quot.rec_on_subsingleton s
+  (λ l, match list.decidable_mem a (elt_of l) with
+        | decidable.inl p := decidable.inl (mem_of_mem_list p)
+        | decidable.inr n := decidable.inr (λ p, absurd (mem_list_of_mem p) n)
+        end)
+
+theorem mem_to_finset [decidable_eq A] {a : A} {l : list A} : a ∈ l → a ∈ to_finset l :=
+λ ainl, mem_erase_dup ainl
+
+theorem mem_to_finset_of_nodup {a : A} {l : list A} (n : nodup l) : a ∈ l → a ∈ to_finset_of_nodup l n :=
+λ ainl, ainl
+
+/- extensionality -/
+theorem ext {s₁ s₂ : finset A} : (∀ a, a ∈ s₁ ↔ a ∈ s₂) → s₁ = s₂ :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ e, quot.sound (perm_ext (has_property l₁) (has_property l₂) e))
+
+/- empty -/
+definition empty : finset A :=
+to_finset_of_nodup [] nodup_nil
+
+notation [priority finset.prio] `∅` := !empty
+
+attribute [simp]
+theorem not_mem_empty (a : A) : a ∉ ∅ :=
+λ aine : a ∈ ∅, aine
+
+attribute [simp]
+theorem mem_empty_iff (x : A) : x ∈ ∅ ↔ false :=
+iff_false_intro !not_mem_empty
+
+theorem mem_empty_eq (x : A) : x ∈ ∅ = false :=
+propext !mem_empty_iff
+
+theorem eq_empty_of_forall_not_mem {s : finset A} (H : ∀x, ¬ x ∈ s) : s = ∅ :=
+ext (take x, iff_false_intro (H x))
+
+/- universe -/
+definition univ [h : fintype A] : finset A :=
+to_finset_of_nodup (@fintype.elems A h) (@fintype.unique A h)
+
+theorem mem_univ [fintype A] (x : A) : x ∈ univ :=
+fintype.complete x
+
+theorem mem_univ_eq [fintype A] (x : A) : x ∈ univ = true := propext (iff_true_intro !mem_univ)
+
+/- card -/
+definition card (s : finset A) : nat :=
+quot.lift_on s
+  (λ l, length (elt_of l))
+  (λ l₁ l₂ p, length_eq_length_of_perm p)
+
+theorem card_empty : card (@empty A) = 0 :=
+rfl
+
+lemma ne_empty_of_card_eq_succ {s : finset A} {n : nat} : card s = succ n → s ≠ ∅ :=
+by intros; substvars; contradiction
+
+/- insert -/
+section insert
+variable [h : decidable_eq A]
+include h
+
+definition insert (a : A) (s : finset A) : finset A :=
+quot.lift_on s
+  (λ l, to_finset_of_nodup (insert a (elt_of l)) (nodup_insert a (has_property l)))
+  (λ (l₁ l₂ : nodup_list A) (p : l₁ ~ l₂), quot.sound (perm_insert a p))
+
+-- set builder notation
+notation [priority finset.prio] `'{`:max a:(foldr `, ` (x b, insert x b) ∅) `}`:0 := a
+
+theorem mem_insert (a : A) (s : finset A) : a ∈ insert a s :=
+quot.induction_on s
+ (λ l : nodup_list A, mem_to_finset_of_nodup _ !list.mem_insert)
+
+theorem mem_insert_of_mem {a : A} {s : finset A} (b : A) : a ∈ s → a ∈ insert b s :=
+quot.induction_on s
+ (λ (l : nodup_list A) (ainl : a ∈ ⟦l⟧), mem_to_finset_of_nodup _ (list.mem_insert_of_mem _ ainl))
+
+theorem eq_or_mem_of_mem_insert {x a : A} {s : finset A} : x ∈ insert a s → x = a ∨ x ∈ s :=
+quot.induction_on s (λ l : nodup_list A, λ H, list.eq_or_mem_of_mem_insert H)
+
+theorem mem_of_mem_insert_of_ne {x a : A} {s : finset A} (xin : x ∈ insert a s) : x ≠ a → x ∈ s :=
+or_resolve_right (eq_or_mem_of_mem_insert xin)
+
+theorem mem_insert_iff (x a : A) (s : finset A) : x ∈ insert a s ↔ (x = a ∨ x ∈ s) :=
+iff.intro !eq_or_mem_of_mem_insert
+  (or.rec (λH', (eq.substr H' !mem_insert)) !mem_insert_of_mem)
+
+theorem mem_insert_eq (x a : A) (s : finset A) : x ∈ insert a s = (x = a ∨ x ∈ s) :=
+propext !mem_insert_iff
+
+theorem mem_singleton_iff (x a : A) : x ∈ '{a} ↔ (x = a) :=
+by rewrite [mem_insert_eq, mem_empty_eq, or_false]
+
+theorem mem_singleton (a : A) : a ∈ '{a} := mem_insert a ∅
+
+theorem mem_singleton_of_eq {x a : A} (H : x = a) : x ∈ '{a} :=
+by rewrite H; apply mem_insert
+
+theorem eq_of_mem_singleton {x a : A} (H : x ∈ '{a}) : x = a := iff.mp !mem_singleton_iff H
+
+theorem eq_of_singleton_eq {a b : A} (H : '{a} = '{b}) : a = b :=
+have a ∈ '{b}, by rewrite -H; apply mem_singleton,
+eq_of_mem_singleton this
+
+theorem insert_eq_of_mem {a : A} {s : finset A} (H : a ∈ s) : insert a s = s :=
+ext (λ x, eq.substr (mem_insert_eq x a s)
+   (or_iff_right_of_imp (λH1, eq.substr H1 H)))
+
+theorem singleton_ne_empty (a : A) : '{a} ≠ ∅ :=
+begin
+  intro H,
+  apply not_mem_empty a,
+  rewrite -H,
+  apply mem_insert
+end
+
+theorem pair_eq_singleton (a : A) : '{a, a} = '{a} :=
+by rewrite [insert_eq_of_mem !mem_singleton]
+
+-- useful in proofs by induction
+theorem forall_of_forall_insert {P : A → Prop} {a : A} {s : finset A}
+    (H : ∀ x, x ∈ insert a s → P x) :
+  ∀ x, x ∈ s → P x :=
+λ x xs, H x (!mem_insert_of_mem xs)
+
+theorem insert.comm (x y : A) (s : finset A) : insert x (insert y s) = insert y (insert x s) :=
+ext (take a, by rewrite [*mem_insert_eq, propext !or.left_comm])
+
+theorem card_insert_of_mem {a : A} {s : finset A} : a ∈ s → card (insert a s) = card s :=
+quot.induction_on s
+  (λ (l : nodup_list A) (ainl : a ∈ ⟦l⟧), list.length_insert_of_mem ainl)
+
+theorem card_insert_of_not_mem {a : A} {s : finset A} : a ∉ s → card (insert a s) = card s + 1 :=
+quot.induction_on s
+  (λ (l : nodup_list A) (nainl : a ∉ ⟦l⟧), list.length_insert_of_not_mem nainl)
+
+theorem card_insert_le (a : A) (s : finset A) :
+  card (insert a s) ≤ card s + 1 :=
+if H : a ∈ s then by rewrite [card_insert_of_mem H]; apply le_succ
+else by rewrite [card_insert_of_not_mem H]
+
+attribute [recursor 6]
+protected theorem induction {P : finset A → Prop}
+    (H1 : P empty)
+    (H2 : ∀ ⦃a : A⦄, ∀{s : finset A}, a ∉ s → P s → P (insert a s)) :
+  ∀s, P s :=
+take s,
+quot.induction_on s
+ (take u,
+  subtype.destruct u
+   (take l,
+    list.induction_on l
+      (assume nodup_l, H1)
+      (take a l',
+        assume IH nodup_al',
+        have aux₁: a ∉ l', from not_mem_of_nodup_cons nodup_al',
+        have e : list.insert a l' = a :: l', from insert_eq_of_not_mem aux₁,
+        have nodup l', from nodup_of_nodup_cons nodup_al',
+        have P (quot.mk (subtype.tag l' this)), from IH this,
+        have P (insert a (quot.mk (subtype.tag l' _))), from H2 aux₁ this,
+        begin
+          revert nodup_al',
+          rewrite [-e],
+          intros,
+          apply this
+        end)))
+
+protected theorem induction_on {P : finset A → Prop} (s : finset A)
+    (H1 : P empty)
+    (H2 : ∀ ⦃a : A⦄, ∀ {s : finset A}, a ∉ s → P s → P (insert a s)) :
+  P s :=
+finset.induction H1 H2 s
+
+theorem exists_mem_of_ne_empty {s : finset A} : s ≠ ∅ → ∃ a : A, a ∈ s :=
+begin
+  induction s with a s nin ih,
+    {intro h, exact absurd rfl h},
+    {intro h, existsi a, apply mem_insert}
+end
+
+theorem eq_empty_of_card_eq_zero {s : finset A} (H : card s = 0) : s = ∅ :=
+begin
+  induction s with a s' H1 IH,
+  { reflexivity },
+  { rewrite (card_insert_of_not_mem H1) at H, apply nat.no_confusion H}
+end
+
+end insert
+
+/- erase -/
+section erase
+variable [h : decidable_eq A]
+include h
+
+definition erase (a : A) (s : finset A) : finset A :=
+quot.lift_on s
+  (λ l, to_finset_of_nodup (erase a (elt_of l)) (nodup_erase_of_nodup a (has_property l)))
+  (λ (l₁ l₂ : nodup_list A) (p : l₁ ~ l₂), quot.sound (erase_perm_erase_of_perm a p))
+
+theorem not_mem_erase (a : A) (s : finset A) : a ∉ erase a s :=
+quot.induction_on s
+  (λ l, list.mem_erase_of_nodup _ (has_property l))
+
+theorem card_erase_of_mem {a : A} {s : finset A} : a ∈ s → card (erase a s) = pred (card s) :=
+quot.induction_on s (λ l ainl, list.length_erase_of_mem ainl)
+
+theorem card_erase_of_not_mem {a : A} {s : finset A} : a ∉ s → card (erase a s) = card s :=
+quot.induction_on s (λ l nainl, list.length_erase_of_not_mem nainl)
+
+theorem erase_empty (a : A) : erase a ∅ = ∅ :=
+rfl
+
+theorem ne_of_mem_erase {a b : A} {s : finset A} : b ∈ erase a s → b ≠ a :=
+by intro h beqa; subst b; exact absurd h !not_mem_erase
+
+theorem mem_of_mem_erase {a b : A} {s : finset A} : b ∈ erase a s → b ∈ s :=
+quot.induction_on s (λ l bin, mem_of_mem_erase bin)
+
+theorem mem_erase_of_ne_of_mem {a b : A} {s : finset A} : a ≠ b → a ∈ s → a ∈ erase b s :=
+quot.induction_on s (λ l n ain, list.mem_erase_of_ne_of_mem n ain)
+
+theorem mem_erase_iff (a b : A) (s : finset A) : a ∈ erase b s ↔ a ∈ s ∧ a ≠ b :=
+iff.intro
+  (assume H, and.intro (mem_of_mem_erase H) (ne_of_mem_erase H))
+  (assume H, mem_erase_of_ne_of_mem (and.right H) (and.left H))
+
+theorem mem_erase_eq (a b : A) (s : finset A) : a ∈ erase b s = (a ∈ s ∧ a ≠ b) :=
+propext !mem_erase_iff
+
+open decidable
+theorem erase_insert {a : A} {s : finset A} : a ∉ s → erase a (insert a s) = s :=
+λ anins, finset.ext (λ b, by_cases
+  (λ beqa : b = a, iff.intro
+    (λ bin, by subst b; exact absurd bin !not_mem_erase)
+    (λ bin, by subst b; contradiction))
+  (λ bnea : b ≠ a, iff.intro
+    (λ bin,
+       have b ∈ insert a s, from mem_of_mem_erase bin,
+       mem_of_mem_insert_of_ne this bnea)
+    (λ bin,
+      have b ∈ insert a s, from mem_insert_of_mem _ bin,
+      mem_erase_of_ne_of_mem bnea this)))
+
+theorem insert_erase {a : A} {s : finset A} : a ∈ s → insert a (erase a s) = s :=
+λ ains, finset.ext (λ b, by_cases
+  (suppose b = a, iff.intro
+    (λ bin, by subst b; assumption)
+    (λ bin, by subst b; apply mem_insert))
+  (suppose b ≠ a, iff.intro
+    (λ bin, mem_of_mem_erase (mem_of_mem_insert_of_ne bin `b ≠ a`))
+    (λ bin, mem_insert_of_mem _ (mem_erase_of_ne_of_mem `b ≠ a` bin))))
+end erase
+
+/- union -/
+section union
+variable [h : decidable_eq A]
+include h
+
+definition union (s₁ s₂ : finset A) : finset A :=
+quot.lift_on₂ s₁ s₂
+  (λ l₁ l₂,
+    to_finset_of_nodup (list.union (elt_of l₁) (elt_of l₂))
+                       (nodup_union_of_nodup_of_nodup (has_property l₁) (has_property l₂)))
+  (λ v₁ v₂ w₁ w₂ p₁ p₂, quot.sound (perm_union p₁ p₂))
+
+infix [priority finset.prio] ∪ := union
+
+theorem mem_union_left {a : A} {s₁ : finset A} (s₂ : finset A) : a ∈ s₁ → a ∈ s₁ ∪ s₂ :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ ainl₁, list.mem_union_left _ ainl₁)
+
+theorem mem_union_l {a : A} {s₁ : finset A} {s₂ : finset A} : a ∈ s₁ → a ∈ s₁ ∪ s₂ :=
+mem_union_left s₂
+
+theorem mem_union_right {a : A} {s₂ : finset A} (s₁ : finset A) : a ∈ s₂ → a ∈ s₁ ∪ s₂ :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ ainl₂, list.mem_union_right _ ainl₂)
+
+theorem mem_union_r {a : A} {s₂ : finset A} {s₁ : finset A} : a ∈ s₂ → a ∈ s₁ ∪ s₂ :=
+mem_union_right s₁
+
+theorem mem_or_mem_of_mem_union {a : A} {s₁ s₂ : finset A} : a ∈ s₁ ∪ s₂ → a ∈ s₁ ∨ a ∈ s₂ :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ ainl₁l₂, list.mem_or_mem_of_mem_union ainl₁l₂)
+
+theorem mem_union_iff (a : A) (s₁ s₂ : finset A) : a ∈ s₁ ∪ s₂ ↔ a ∈ s₁ ∨ a ∈ s₂ :=
+iff.intro
+ (λ h, mem_or_mem_of_mem_union h)
+ (λ d, or.elim d
+   (λ i, mem_union_left _ i)
+   (λ i, mem_union_right _ i))
+
+theorem mem_union_eq (a : A) (s₁ s₂ : finset A) : (a ∈ s₁ ∪ s₂) = (a ∈ s₁ ∨ a ∈ s₂) :=
+propext !mem_union_iff
+
+theorem union_comm (s₁ s₂ : finset A) : s₁ ∪ s₂ = s₂ ∪ s₁ :=
+ext (λ a, by rewrite [*mem_union_eq]; exact or.comm)
+
+theorem union_assoc (s₁ s₂ s₃ : finset A) : (s₁ ∪ s₂) ∪ s₃ = s₁ ∪ (s₂ ∪ s₃) :=
+ext (λ a, by rewrite [*mem_union_eq]; exact or.assoc)
+
+theorem union_left_comm (s₁ s₂ s₃ : finset A) : s₁ ∪ (s₂ ∪ s₃) = s₂ ∪ (s₁ ∪ s₃) :=
+!left_comm union_comm union_assoc s₁ s₂ s₃
+
+theorem union_right_comm (s₁ s₂ s₃ : finset A) : (s₁ ∪ s₂) ∪ s₃ = (s₁ ∪ s₃) ∪ s₂ :=
+!right_comm union_comm union_assoc s₁ s₂ s₃
+
+theorem union_self (s : finset A) : s ∪ s = s :=
+ext (λ a, iff.intro
+  (λ ain, or.elim (mem_or_mem_of_mem_union ain) (λ i, i) (λ i, i))
+  (λ i, mem_union_left _ i))
+
+theorem union_empty (s : finset A) : s ∪ ∅ = s :=
+ext (λ a, iff.intro
+  (suppose a ∈ s ∪ ∅, or.elim (mem_or_mem_of_mem_union this) (λ i, i) (λ i, absurd i !not_mem_empty))
+  (suppose a ∈ s, mem_union_left _ this))
+
+theorem empty_union (s : finset A) : ∅ ∪ s = s :=
+calc ∅ ∪ s = s ∪ ∅ : union_comm
+       ... = s     : union_empty
+
+theorem insert_eq (a : A) (s : finset A) : insert a s = '{a} ∪ s :=
+ext (take x, by rewrite [mem_insert_iff, mem_union_iff, mem_singleton_iff])
+
+theorem insert_union (a : A) (s t : finset A) : insert a (s ∪ t) = insert a s ∪ t :=
+by rewrite [insert_eq, insert_eq a s, union_assoc]
+end union
+
+/- inter -/
+section inter
+variable [h : decidable_eq A]
+include h
+
+definition inter (s₁ s₂ : finset A) : finset A :=
+quot.lift_on₂ s₁ s₂
+  (λ l₁ l₂,
+    to_finset_of_nodup (list.inter (elt_of l₁) (elt_of l₂))
+                       (nodup_inter_of_nodup _ (has_property l₁)))
+  (λ v₁ v₂ w₁ w₂ p₁ p₂, quot.sound (perm_inter p₁ p₂))
+
+infix [priority finset.prio] ∩ := inter
+
+theorem mem_of_mem_inter_left {a : A} {s₁ s₂ : finset A} : a ∈ s₁ ∩ s₂ → a ∈ s₁ :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ ainl₁l₂, list.mem_of_mem_inter_left ainl₁l₂)
+
+theorem mem_of_mem_inter_right {a : A} {s₁ s₂ : finset A} : a ∈ s₁ ∩ s₂ → a ∈ s₂ :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ ainl₁l₂, list.mem_of_mem_inter_right ainl₁l₂)
+
+theorem mem_inter {a : A} {s₁ s₂ : finset A} : a ∈ s₁ → a ∈ s₂ → a ∈ s₁ ∩ s₂ :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ ainl₁ ainl₂, list.mem_inter_of_mem_of_mem ainl₁ ainl₂)
+
+theorem mem_inter_iff (a : A) (s₁ s₂ : finset A) : a ∈ s₁ ∩ s₂ ↔ a ∈ s₁ ∧ a ∈ s₂ :=
+iff.intro
+ (λ h, and.intro (mem_of_mem_inter_left h) (mem_of_mem_inter_right h))
+ (λ h, mem_inter (and.elim_left h) (and.elim_right h))
+
+theorem mem_inter_eq (a : A) (s₁ s₂ : finset A) : (a ∈ s₁ ∩ s₂) = (a ∈ s₁ ∧ a ∈ s₂) :=
+propext !mem_inter_iff
+
+theorem inter_comm (s₁ s₂ : finset A) : s₁ ∩ s₂ = s₂ ∩ s₁ :=
+ext (λ a, by rewrite [*mem_inter_eq]; exact and.comm)
+
+theorem inter_assoc (s₁ s₂ s₃ : finset A) : (s₁ ∩ s₂) ∩ s₃ = s₁ ∩ (s₂ ∩ s₃) :=
+ext (λ a, by rewrite [*mem_inter_eq]; exact and.assoc)
+
+theorem inter_left_comm (s₁ s₂ s₃ : finset A) : s₁ ∩ (s₂ ∩ s₃) = s₂ ∩ (s₁ ∩ s₃) :=
+!left_comm inter_comm inter_assoc s₁ s₂ s₃
+
+theorem inter_right_comm (s₁ s₂ s₃ : finset A) : (s₁ ∩ s₂) ∩ s₃ = (s₁ ∩ s₃) ∩ s₂ :=
+!right_comm inter_comm inter_assoc s₁ s₂ s₃
+
+theorem inter_self (s : finset A) : s ∩ s = s :=
+ext (λ a, iff.intro
+  (λ h, mem_of_mem_inter_right h)
+  (λ h, mem_inter h h))
+
+theorem inter_empty (s : finset A) : s ∩ ∅ = ∅ :=
+ext (λ a, iff.intro
+  (suppose a ∈ s ∩ ∅, absurd (mem_of_mem_inter_right this) !not_mem_empty)
+  (suppose a ∈ ∅,     absurd this !not_mem_empty))
+
+theorem empty_inter (s : finset A) : ∅ ∩ s = ∅ :=
+calc ∅ ∩ s = s ∩ ∅ : inter_comm
+       ... = ∅     : inter_empty
+
+theorem singleton_inter_of_mem {a : A} {s : finset A} (H : a ∈ s) :
+  '{a} ∩ s = '{a} :=
+ext (take x,
+  begin
+    rewrite [mem_inter_eq, !mem_singleton_iff],
+    exact iff.intro
+      (suppose x = a ∧ x ∈ s, and.left this)
+      (suppose x = a, and.intro this (eq.subst (eq.symm this) H))
+  end)
+
+theorem singleton_inter_of_not_mem {a : A} {s : finset A} (H : a ∉ s) :
+  '{a} ∩ s = ∅ :=
+ext (take x,
+  begin
+    rewrite [mem_inter_eq, !mem_singleton_iff, mem_empty_eq],
+    exact iff.intro
+      (suppose x = a ∧ x ∈ s, H (eq.subst (and.left this) (and.right this)))
+      (false.elim)
+  end)
+end inter
+
+/- distributivity laws -/
+section inter
+variable [h : decidable_eq A]
+include h
+
+theorem inter_distrib_left (s t u : finset A) : s ∩ (t ∪ u) = (s ∩ t) ∪ (s ∩ u) :=
+ext (take x, by rewrite [mem_inter_eq, *mem_union_eq, *mem_inter_eq]; apply and.left_distrib)
+
+theorem inter_distrib_right (s t u : finset A) : (s ∪ t) ∩ u = (s ∩ u) ∪ (t ∩ u) :=
+ext (take x, by rewrite [mem_inter_eq, *mem_union_eq, *mem_inter_eq]; apply and.right_distrib)
+
+theorem union_distrib_left (s t u : finset A) : s ∪ (t ∩ u) = (s ∪ t) ∩ (s ∪ u) :=
+ext (take x, by rewrite [mem_union_eq, *mem_inter_eq, *mem_union_eq]; apply or.left_distrib)
+
+theorem union_distrib_right (s t u : finset A) : (s ∩ t) ∪ u = (s ∪ u) ∩ (t ∪ u) :=
+ext (take x, by rewrite [mem_union_eq, *mem_inter_eq, *mem_union_eq]; apply or.right_distrib)
+end inter
+
+/- disjoint -/
+-- Mainly for internal use; library will use s₁ ∩ s₂ = ∅. Note that it does not require decidable equality.
+definition disjoint (s₁ s₂ : finset A) : Prop :=
+quot.lift_on₂ s₁ s₂ (λ l₁ l₂, disjoint (elt_of l₁) (elt_of l₂))
+  (λ v₁ v₂ w₁ w₂ p₁ p₂, propext (iff.intro
+    (λ d₁ a (ainw₁ : a ∈ elt_of w₁),
+      have a ∈ elt_of v₁, from mem_perm (perm.symm p₁) ainw₁,
+      have a ∉ elt_of v₂, from disjoint_left d₁ this,
+      not_mem_perm p₂ this)
+    (λ d₂ a (ainv₁ : a ∈ elt_of v₁),
+      have a ∈ elt_of w₁, from mem_perm p₁ ainv₁,
+      have a ∉ elt_of w₂, from disjoint_left d₂ this,
+      not_mem_perm (perm.symm p₂) this)))
+
+theorem disjoint.elim {s₁ s₂ : finset A} {x : A} :
+  disjoint s₁ s₂ → x ∈ s₁ → x ∈ s₂ → false :=
+quot.induction_on₂ s₁ s₂ (take u₁ u₂, assume H H1 H2, H x H1 H2)
+
+theorem disjoint.intro {s₁ s₂ : finset A} : (∀{x : A}, x ∈ s₁ → x ∈ s₂ → false) → disjoint s₁ s₂ :=
+quot.induction_on₂ s₁ s₂ (take u₁ u₂, assume H, H)
+
+theorem inter_eq_empty_of_disjoint [h : decidable_eq A] {s₁ s₂ : finset A} (H : disjoint s₁ s₂) : s₁ ∩ s₂ = ∅ :=
+ext (take x, iff_false_intro (assume H1,
+  disjoint.elim H (mem_of_mem_inter_left H1) (mem_of_mem_inter_right H1)))
+
+theorem disjoint_of_inter_eq_empty [h : decidable_eq A] {s₁ s₂ : finset A} (H : s₁ ∩ s₂ = ∅) : disjoint s₁ s₂ :=
+disjoint.intro (take x H1 H2,
+  have x ∈ s₁ ∩ s₂, from mem_inter H1 H2,
+  !not_mem_empty (eq.subst H this))
+
+theorem disjoint.comm {s₁ s₂ : finset A} : disjoint s₁ s₂ → disjoint s₂ s₁ :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ d, list.disjoint.comm d)
+
+theorem inter_eq_empty [h : decidable_eq A] {s₁ s₂ : finset A}
+    (H : ∀x : A, x ∈ s₁ → x ∈ s₂ → false) : s₁ ∩ s₂ = ∅ :=
+inter_eq_empty_of_disjoint (disjoint.intro H)
+
+/- subset -/
+definition subset (s₁ s₂ : finset A) : Prop :=
+quot.lift_on₂ s₁ s₂
+  (λ l₁ l₂, sublist (elt_of l₁) (elt_of l₂))
+  (λ v₁ v₂ w₁ w₂ p₁ p₂, propext (iff.intro
+    (λ s₁ a i, mem_perm p₂ (s₁ a (mem_perm (perm.symm p₁) i)))
+    (λ s₂ a i, mem_perm (perm.symm p₂) (s₂ a (mem_perm p₁ i)))))
+
+infix [priority finset.prio] ⊆ := subset
+
+theorem empty_subset (s : finset A) : ∅ ⊆ s :=
+quot.induction_on s (λ l, list.nil_sub (elt_of l))
+
+theorem subset_univ [h : fintype A] (s : finset A) : s ⊆ univ :=
+quot.induction_on s (λ l a i, fintype.complete a)
+
+theorem subset.refl (s : finset A) : s ⊆ s :=
+quot.induction_on s (λ l, list.sub.refl (elt_of l))
+
+theorem subset.trans {s₁ s₂ s₃ : finset A} : s₁ ⊆ s₂ → s₂ ⊆ s₃ → s₁ ⊆ s₃ :=
+quot.induction_on₃ s₁ s₂ s₃ (λ l₁ l₂ l₃ h₁ h₂, list.sub.trans h₁ h₂)
+
+theorem mem_of_subset_of_mem {s₁ s₂ : finset A} {a : A} : s₁ ⊆ s₂ → a ∈ s₁ → a ∈ s₂ :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ h₁ h₂, h₁ a h₂)
+
+theorem subset.antisymm {s₁ s₂ : finset A} (H₁ : s₁ ⊆ s₂) (H₂ : s₂ ⊆ s₁) : s₁ = s₂ :=
+ext (take x, iff.intro (assume H, mem_of_subset_of_mem H₁ H) (assume H, mem_of_subset_of_mem H₂ H))
+
+-- alternative name
+theorem eq_of_subset_of_subset {s₁ s₂ : finset A} (H₁ : s₁ ⊆ s₂) (H₂ : s₂ ⊆ s₁) : s₁ = s₂ :=
+subset.antisymm H₁ H₂
+
+theorem subset_of_forall {s₁ s₂ : finset A} : (∀x, x ∈ s₁ → x ∈ s₂) → s₁ ⊆ s₂ :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ H, H)
+
+theorem subset_insert [h : decidable_eq A] (s : finset A) (a : A) : s ⊆ insert a s :=
+subset_of_forall (take x, suppose x ∈ s, mem_insert_of_mem _ this)
+
+theorem eq_empty_of_subset_empty {x : finset A} (H : x ⊆ ∅) : x = ∅ :=
+subset.antisymm H (empty_subset x)
+
+theorem subset_empty_iff (x : finset A) : x ⊆ ∅ ↔ x = ∅ :=
+iff.intro eq_empty_of_subset_empty (take xeq, by rewrite xeq; apply subset.refl ∅)
+
+section
+variable [decA : decidable_eq A]
+include decA
+
+theorem erase_subset_erase (a : A) {s t : finset A} (H : s ⊆ t) : erase a s ⊆ erase a t :=
+begin
+  apply subset_of_forall,
+  intro x,
+  rewrite *mem_erase_eq,
+  intro H',
+  show x ∈ t ∧ x ≠ a, from and.intro (mem_of_subset_of_mem H (and.left H')) (and.right H')
+end
+
+theorem erase_subset  (a : A) (s : finset A) : erase a s ⊆ s :=
+begin
+  apply subset_of_forall,
+  intro x,
+  rewrite mem_erase_eq,
+  intro H,
+  apply and.left H
+end
+
+theorem erase_eq_of_not_mem {a : A} {s : finset A} (anins : a ∉ s) : erase a s = s :=
+eq_of_subset_of_subset !erase_subset
+  (subset_of_forall (take x, assume xs : x ∈ s,
+    have x ≠ a, from assume H', anins (eq.subst H' xs),
+    mem_erase_of_ne_of_mem this xs))
+
+theorem erase_insert_subset (a : A) (s : finset A) : erase a (insert a s) ⊆ s :=
+decidable.by_cases
+  (assume ains : a ∈ s, by rewrite [insert_eq_of_mem ains]; apply erase_subset)
+  (assume nains : a ∉ s, by rewrite [!erase_insert nains]; apply subset.refl)
+
+theorem erase_subset_of_subset_insert {a : A} {s t : finset A} (H : s ⊆ insert a t) :
+  erase a s ⊆ t :=
+subset.trans (!erase_subset_erase H) !erase_insert_subset
+
+theorem insert_erase_subset (a : A) (s : finset A) : s ⊆ insert a (erase a s) :=
+decidable.by_cases
+  (assume ains : a ∈ s, by rewrite [!insert_erase ains]; apply subset.refl)
+  (assume nains : a ∉ s, by rewrite[erase_eq_of_not_mem nains]; apply subset_insert)
+
+theorem insert_subset_insert (a : A) {s t : finset A} (H : s ⊆ t) : insert a s ⊆ insert a t :=
+begin
+  apply subset_of_forall,
+  intro x,
+  rewrite *mem_insert_eq,
+  intro H',
+  cases H' with [xeqa, xins],
+    exact (or.inl xeqa),
+  exact (or.inr (mem_of_subset_of_mem H xins))
+end
+
+theorem subset_insert_of_erase_subset {s t : finset A} {a : A} (H : erase a s ⊆ t) :
+  s ⊆ insert a t :=
+subset.trans (insert_erase_subset a s) (!insert_subset_insert H)
+
+theorem subset_insert_iff (s t : finset A) (a : A) : s ⊆ insert a t ↔ erase a s ⊆ t :=
+iff.intro !erase_subset_of_subset_insert !subset_insert_of_erase_subset
+
+end
+
+/- upto -/
+section upto
+definition upto (n : nat) : finset nat :=
+to_finset_of_nodup (list.upto n) (nodup_upto n)
+
+theorem card_upto : ∀ n, card (upto n) = n :=
+list.length_upto
+
+theorem lt_of_mem_upto {n a : nat} : a ∈ upto n → a < n :=
+list.lt_of_mem_upto
+
+theorem mem_upto_succ_of_mem_upto {n a : nat} : a ∈ upto n → a ∈ upto (succ n) :=
+list.mem_upto_succ_of_mem_upto
+
+theorem mem_upto_of_lt {n a : nat} : a < n → a ∈ upto n :=
+list.mem_upto_of_lt
+
+theorem mem_upto_iff (a n : nat) : a ∈ upto n ↔ a < n :=
+iff.intro lt_of_mem_upto mem_upto_of_lt
+
+theorem mem_upto_eq (a n : nat) : a ∈ upto n = (a < n) :=
+propext !mem_upto_iff
+end upto
+
+theorem upto_zero : upto 0 = ∅ := rfl
+
+theorem upto_succ (n : ℕ) : upto (succ n) = upto n ∪ '{n} :=
+begin
+  apply ext, intro x,
+  rewrite [mem_union_iff, *mem_upto_iff, mem_singleton_iff, lt_succ_iff_le, nat.le_iff_lt_or_eq],
+end
+
+/- useful rules for calculations with quantifiers -/
+theorem exists_mem_empty_iff {A : Type} (P : A → Prop) : (∃ x, x ∈ ∅ ∧ P x) ↔ false :=
+iff.intro
+  (assume H,
+    obtain x (H1 : x ∈ ∅ ∧ P x), from H,
+    !not_mem_empty (and.left H1))
+  (assume H, false.elim H)
+
+theorem exists_mem_empty_eq {A : Type} (P : A → Prop) : (∃ x, x ∈ ∅ ∧ P x) = false :=
+propext !exists_mem_empty_iff
+
+theorem exists_mem_insert_iff {A : Type} [d : decidable_eq A]
+    (a : A) (s : finset A) (P : A → Prop) :
+  (∃ x, x ∈ insert a s ∧ P x) ↔ P a ∨ (∃ x, x ∈ s ∧ P x) :=
+iff.intro
+  (assume H,
+    obtain x [H1 H2], from H,
+    or.elim (eq_or_mem_of_mem_insert H1)
+      (suppose x = a, or.inl (eq.subst this H2))
+      (suppose x ∈ s, or.inr (exists.intro x (and.intro this H2))))
+  (assume H,
+    or.elim H
+      (suppose P a, exists.intro a (and.intro !mem_insert this))
+      (suppose ∃ x, x ∈ s ∧ P x,
+        obtain x [H2 H3], from this,
+        exists.intro x (and.intro (!mem_insert_of_mem H2) H3)))
+
+theorem exists_mem_insert_eq {A : Type} [d : decidable_eq A] (a : A) (s : finset A) (P : A → Prop) :
+  (∃ x, x ∈ insert a s ∧ P x) = (P a ∨ (∃ x, x ∈ s ∧ P x)) :=
+propext !exists_mem_insert_iff
+
+theorem forall_mem_empty_iff {A : Type} (P : A → Prop) : (∀ x, x ∈ ∅ → P x) ↔ true :=
+iff.intro
+  (assume H, trivial)
+  (assume H, take x, assume H', absurd H' !not_mem_empty)
+
+theorem forall_mem_empty_eq {A : Type} (P : A → Prop) : (∀ x, x ∈ ∅ → P x) = true :=
+propext !forall_mem_empty_iff
+
+theorem forall_mem_insert_iff {A : Type} [d : decidable_eq A]
+    (a : A) (s : finset A) (P : A → Prop) :
+  (∀ x, x ∈ insert a s → P x) ↔ P a ∧ (∀ x, x ∈ s → P x) :=
+iff.intro
+  (assume H, and.intro (H _ !mem_insert) (take x, assume H', H _ (!mem_insert_of_mem H')))
+  (assume H, take x, assume H' : x ∈ insert a s,
+    or.elim (eq_or_mem_of_mem_insert H')
+      (suppose x = a, eq.subst (eq.symm this) (and.left H))
+      (suppose x ∈ s, and.right H _ this))
+
+theorem forall_mem_insert_eq {A : Type} [d : decidable_eq A] (a : A) (s : finset A) (P : A → Prop) :
+  (∀ x, x ∈ insert a s → P x) = (P a ∧ (∀ x, x ∈ s → P x)) :=
+propext !forall_mem_insert_iff
+
+end finset

old_library/data/finset/bigops.lean

@@ -0,0 +1,136 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad, Haitao Zhang
+
+Finite unions and intersections on finsets.
+
+Note: for the moment we only do unions. We need to generalize bigops for intersections.
+-/
+import data.finset.comb algebra.group_bigops
+open list
+
+namespace finset
+
+variables {A B : Type} [deceqA : decidable_eq A] [deceqB : decidable_eq B]
+
+/- Unionl and Union -/
+
+section union
+
+definition to_comm_monoid_Union (B : Type) [decidable_eq B] :
+  comm_monoid (finset B) :=
+⦃ comm_monoid,
+  mul         := union,
+  mul_assoc   := union_assoc,
+  one         := empty,
+  mul_one     := union_empty,
+  one_mul     := empty_union,
+  mul_comm    := union_comm
+⦄
+
+local attribute finset.to_comm_monoid_Union [instance]
+
+include deceqB
+
+definition Unionl (l : list A) (f : A → finset B) : finset B := Prodl l f
+notation `⋃` binders `←` l, r:(scoped f, Unionl l f) := r
+definition Union (s : finset A) (f : A → finset B) : finset B := finset.Prod s f
+notation `⋃` binders `∈` s, r:(scoped f, finset.Union s f) := r
+
+theorem Unionl_nil (f : A → finset B) : Unionl [] f = ∅ := Prodl_nil f
+theorem Unionl_cons (f : A → finset B) (a : A) (l : list A) :
+  Unionl (a::l) f = f a ∪ Unionl l f := Prodl_cons f a l
+theorem Unionl_append (l₁ l₂ : list A) (f : A → finset B) :
+  Unionl (l₁++l₂) f = Unionl l₁ f ∪ Unionl l₂ f := Prodl_append l₁ l₂ f
+theorem Unionl_mul (l : list A) (f g : A → finset B) :
+  Unionl l (λx, f x ∪ g x) = Unionl l f ∪ Unionl l g := Prodl_mul l f g
+section deceqA
+  include deceqA
+  theorem Unionl_insert_of_mem (f : A → finset B) {a : A} {l : list A} (H : a ∈ l) :
+    Unionl (list.insert a l) f = Unionl l f := Prodl_insert_of_mem f H
+  theorem Unionl_insert_of_not_mem (f : A → finset B) {a : A} {l : list A} (H : a ∉ l) :
+    Unionl (list.insert a l) f = f a ∪ Unionl l f := Prodl_insert_of_not_mem f H
+  theorem Unionl_union {l₁ l₂ : list A} (f : A → finset B) (d : list.disjoint l₁ l₂) :
+    Unionl (list.union l₁ l₂) f = Unionl l₁ f ∪ Unionl l₂ f := Prodl_union f d
+  theorem Unionl_empty (l : list A) : Unionl l (λ x, ∅) = (∅ : finset B) := Prodl_one l
+end deceqA
+
+theorem Union_empty (f : A → finset B) : Union ∅ f = ∅ := finset.Prod_empty f
+theorem Union_mul (s : finset A) (f g : A → finset B) :
+  Union s (λx, f x ∪ g x) = Union s f ∪ Union s g := finset.Prod_mul s f g
+section deceqA
+  include deceqA
+  theorem Union_insert_of_mem (f : A → finset B) {a : A} {s : finset A} (H : a ∈ s) :
+    Union (insert a s) f = Union s f := finset.Prod_insert_of_mem f H
+  private theorem Union_insert_of_not_mem (f : A → finset B) {a : A} {s : finset A} (H : a ∉ s) :
+    Union (insert a s) f = f a ∪ Union s f := finset.Prod_insert_of_not_mem f H
+  theorem Union_union (f : A → finset B) {s₁ s₂ : finset A} (disj : s₁ ∩ s₂ = ∅) :
+    Union (s₁ ∪ s₂) f = Union s₁ f ∪ Union s₂ f := finset.Prod_union f disj
+  theorem Union_ext {s : finset A} {f g : A → finset B} (H : ∀x, x ∈ s → f x = g x) :
+    Union s f = Union s g := finset.Prod_ext H
+  theorem Union_empty' (s : finset A) : Union s (λ x, ∅) = (∅ : finset B) := finset.Prod_one s
+
+  -- this will eventually be an instance of something more general
+  theorem inter_Union (s : finset B) (t : finset A) (f : A → finset B) :
+      s ∩ (⋃ x ∈ t, f x) = (⋃ x ∈ t, s ∩ f x) :=
+  begin
+    induction t with s' x H IH,
+      rewrite [*Union_empty, inter_empty],
+      rewrite [*Union_insert_of_not_mem _ H, inter_distrib_left, IH],
+  end
+
+  theorem mem_Union_iff (s : finset A) (f : A → finset B) (b : B) :
+    b ∈ (⋃ x ∈ s, f x) ↔ (∃ x, x ∈ s ∧ b ∈ f x ) :=
+  begin
+    induction s with s' a H IH,
+      rewrite [exists_mem_empty_eq],
+      rewrite [Union_insert_of_not_mem _ H, mem_union_eq, IH, exists_mem_insert_eq]
+  end
+
+  theorem mem_Union_eq (s : finset A) (f : A → finset B) (b : B) :
+    b ∈ (⋃ x ∈ s, f x) = (∃ x, x ∈ s ∧ b ∈ f x ) :=
+  propext !mem_Union_iff
+
+  theorem Union_insert (f : A → finset B) {a : A} {s : finset A} :
+    Union (insert a s) f = f a ∪ Union s f :=
+  decidable.by_cases
+    (assume Pin : a ∈ s,
+      begin
+        rewrite [Union_insert_of_mem f Pin],
+        apply ext,
+        intro x,
+        apply iff.intro,
+          exact mem_union_r,
+          rewrite [mem_union_eq],
+          intro Por,
+          exact or.elim Por
+            (assume Pl, begin
+              rewrite mem_Union_eq, exact (exists.intro a (and.intro Pin Pl)) end)
+            (assume Pr, Pr)
+      end)
+    (assume H : a ∉ s, !Union_insert_of_not_mem H)
+
+  lemma image_eq_Union_index_image (s : finset A) (f : A → finset B) :
+    Union s f = Union (image f s) id :=
+      finset.induction_on s
+        (by rewrite Union_empty)
+        (take s1 a Pa IH, by rewrite [image_insert, *Union_insert, IH])
+
+  lemma Union_const [decidable_eq B] {f : A → finset B} {s : finset A} {t : finset B} :
+    s ≠ ∅ → (∀ x, x ∈ s → f x = t) → Union s f = t :=
+  begin
+    induction s with a' s' H IH,
+      {intros [H1, H2], exfalso, apply H1 !rfl},
+    intros [H1, H2],
+    rewrite [Union_insert, H2 _ !mem_insert],
+    cases (decidable.em (s' = ∅)) with [seq, sne],
+      {rewrite [seq, Union_empty, union_empty]},
+    have H3 : ∀ x, x ∈ s' → f x = t, from (λ x H', H2 x (mem_insert_of_mem _ H')),
+    rewrite [IH sne H3, union_self]
+  end
+end deceqA
+
+end union
+
+end finset

old_library/data/finset/card.lean

@@ -0,0 +1,239 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+
+Cardinality calculations for finite sets.
+-/
+import .to_set .bigops data.set.function data.nat.power
+open nat eq.ops
+
+namespace finset
+
+variables {A B : Type}
+variables [deceqA : decidable_eq A] [deceqB : decidable_eq B]
+include deceqA
+
+theorem card_add_card (s₁ s₂ : finset A) : card s₁ + card s₂ = card (s₁ ∪ s₂) + card (s₁ ∩ s₂) :=
+begin
+  induction s₂ with a s₂ ans2 IH,
+    show card s₁ + card (∅:finset A) = card (s₁ ∪ ∅) + card (s₁ ∩ ∅),
+      by rewrite [union_empty, card_empty, inter_empty],
+    show card s₁ + card (insert a s₂) = card (s₁ ∪ (insert a s₂)) + card (s₁ ∩ (insert a s₂)),
+      from decidable.by_cases
+        (assume as1 : a ∈ s₁,
+          have H : a ∉ s₁ ∩ s₂, from assume H', ans2 (mem_of_mem_inter_right H'),
+          begin
+            rewrite [card_insert_of_not_mem ans2, union_comm, -insert_union, union_comm],
+            rewrite [insert_union, insert_eq_of_mem as1, insert_eq, inter_distrib_left, inter_comm],
+            rewrite [singleton_inter_of_mem as1, -insert_eq, card_insert_of_not_mem H, -*add.assoc],
+            rewrite IH
+          end)
+        (assume ans1 : a ∉ s₁,
+          have H : a ∉ s₁ ∪ s₂, from assume H',
+            or.elim (mem_or_mem_of_mem_union H') (assume as1, ans1 as1) (assume as2, ans2 as2),
+          begin
+            rewrite [card_insert_of_not_mem ans2, union_comm, -insert_union, union_comm],
+            rewrite [card_insert_of_not_mem H, insert_eq, inter_distrib_left, inter_comm],
+            rewrite [singleton_inter_of_not_mem ans1, empty_union, add.right_comm],
+            rewrite [-add.assoc, IH]
+          end)
+end
+
+theorem card_union (s₁ s₂ : finset A) : card (s₁ ∪ s₂) = card s₁ + card s₂ - card (s₁ ∩ s₂) :=
+calc
+  card (s₁ ∪ s₂) = card (s₁ ∪ s₂) + card (s₁ ∩ s₂) - card (s₁ ∩ s₂) : nat.add_sub_cancel
+             ... = card s₁ + card s₂ - card (s₁ ∩ s₂)               : card_add_card
+
+theorem card_union_of_disjoint {s₁ s₂ : finset A} (H : s₁ ∩ s₂ = ∅) :
+  card (s₁ ∪ s₂) = card s₁ + card s₂ :=
+by rewrite [card_union, H]
+
+theorem card_eq_card_add_card_diff {s₁ s₂ : finset A} (H : s₁ ⊆ s₂) :
+  card s₂ = card s₁ + card (s₂ \ s₁) :=
+have H1 : s₁ ∩ (s₂ \ s₁) = ∅,
+  from inter_eq_empty (take x, assume H1 H2, not_mem_of_mem_diff H2 H1),
+calc
+  card s₂ = card (s₁ ∪ (s₂ \ s₁))    : union_diff_cancel H
+      ... = card s₁ + card (s₂ \ s₁) : card_union_of_disjoint H1
+
+theorem card_le_card_of_subset {s₁ s₂ : finset A} (H : s₁ ⊆ s₂) : card s₁ ≤ card s₂ :=
+calc
+  card s₂ = card s₁ + card (s₂ \ s₁) : card_eq_card_add_card_diff H
+      ... ≥ card s₁                  : le_add_right
+
+section card_image
+open set
+include deceqB
+
+theorem card_image_eq_of_inj_on {f : A → B} {s : finset A} (H1 : inj_on f (ts s)) :
+  card (image f s) = card s :=
+begin
+  induction s with a t H IH,
+    { rewrite [card_empty] },
+    { have H2 : ts t ⊆ ts (insert a t), by rewrite [-subset_eq_to_set_subset]; apply subset_insert,
+      have H3 : card (image f t) = card t, from IH (inj_on_of_inj_on_of_subset H1 H2),
+      have H4 : f a ∉ image f t,
+      proof
+        assume H5 : f a ∈ image f t,
+        obtain x (H6l : x ∈ t) (H6r : f x = f a), from exists_of_mem_image H5,
+        have H7 : x = a, from H1 (mem_insert_of_mem _ H6l) !mem_insert H6r,
+        show false, from H (H7 ▸ H6l)
+      qed,
+      calc
+        card (image f (insert a t)) = card (insert (f a) (image f t)) : image_insert
+                                ... = card (image f t) + 1            : card_insert_of_not_mem H4
+                                ... = card t + 1                      : H3
+                                ... = card (insert a t)               : card_insert_of_not_mem H
+    }
+end
+
+lemma card_le_of_inj_on (a : finset A) (b : finset B)
+    (Pex : ∃ f : A → B, set.inj_on f (ts a) ∧ (image f a ⊆ b)):
+  card a ≤ card b :=
+obtain f Pinj, from Pex,
+have Psub : _, from and.right Pinj,
+have Ple : card (image f a) ≤ card b, from card_le_card_of_subset Psub,
+by rewrite [(card_image_eq_of_inj_on (and.left Pinj))⁻¹]; exact Ple
+
+theorem card_image_le (f : A → B) (s : finset A) : card (image f s) ≤ card s :=
+finset.induction_on s
+  (by rewrite finset.image_empty)
+  (take a s',
+    assume Ha : a ∉ s',
+    assume IH : card (image f s') ≤ card s',
+    begin
+      rewrite [image_insert, card_insert_of_not_mem Ha],
+      apply le.trans !card_insert_le,
+      apply add_le_add_right IH
+    end)
+
+theorem inj_on_of_card_image_eq {f : A → B} {s : finset A} :
+  card (image f s) = card s → inj_on f (ts s) :=
+finset.induction_on s
+  (by intro H; rewrite to_set_empty; apply inj_on_empty)
+  (begin
+    intro a s' Ha IH,
+    rewrite [image_insert, card_insert_of_not_mem Ha, to_set_insert],
+    assume H1 : card (insert (f a) (image f s')) = card s' + 1,
+    show inj_on f (set.insert a (ts s')), from
+      decidable.by_cases
+        (assume Hfa : f a ∈ image f s',
+           have H2 : card (image f s') = card s' + 1,
+             by rewrite [card_insert_of_mem Hfa at H1]; assumption,
+           absurd
+             (calc
+               card (image f s') ≤ card s'           : !card_image_le
+                             ... < card s' + 1       : lt_succ_self
+                             ... = card (image f s') : H2)
+             !lt.irrefl)
+        (assume Hnfa : f a ∉ image f s',
+           have H2 : card (image f s') + 1 = card s' + 1,
+             by rewrite [card_insert_of_not_mem Hnfa at H1]; assumption,
+           have H3 : card (image f s') = card s', from add.right_cancel H2,
+           have injf : inj_on f (ts s'), from IH H3,
+           show inj_on f (set.insert a (ts s')), from
+             take x1 x2,
+             assume Hx1 : x1 ∈ set.insert a (ts s'),
+             assume Hx2 : x2 ∈ set.insert a (ts s'),
+             assume feq : f x1 = f x2,
+             or.elim Hx1
+               (assume Hx1' : x1 = a,
+                 or.elim Hx2
+                   (assume Hx2' : x2 = a, by rewrite [Hx1', Hx2'])
+                   (assume Hx2' : x2 ∈ ts s',
+                     have Hfa : f a ∈ image f s',
+                       by rewrite [-Hx1', feq]; apply mem_image_of_mem f Hx2',
+                     absurd Hfa Hnfa))
+               (assume Hx1' : x1 ∈ ts s',
+                 or.elim Hx2
+                   (assume Hx2' : x2 = a,
+                     have Hfa : f a ∈ image f s',
+                       by rewrite [-Hx2', -feq]; apply mem_image_of_mem f Hx1',
+                     absurd Hfa Hnfa)
+                   (assume Hx2' : x2 ∈ ts s', injf Hx1' Hx2' feq)))
+    end)
+
+end card_image
+
+theorem card_pos_of_mem {a : A} {s : finset A} (H : a ∈ s) : card s > 0 :=
+begin
+  induction s with a s' H1 IH,
+  { contradiction },
+  { rewrite (card_insert_of_not_mem H1), apply succ_pos }
+end
+
+theorem eq_of_card_eq_of_subset {s₁ s₂ : finset A} (Hcard : card s₁ = card s₂) (Hsub : s₁ ⊆ s₂) :
+  s₁ = s₂ :=
+have H : card s₁ + 0 = card s₁ + card (s₂ \ s₁),
+  by rewrite [Hcard at {1}, card_eq_card_add_card_diff Hsub],
+have H1 : s₂ \ s₁ = ∅, from eq_empty_of_card_eq_zero (add.left_cancel H)⁻¹,
+by rewrite [-union_diff_cancel Hsub, H1, union_empty]
+
+lemma exists_two_of_card_gt_one {s : finset A} : 1 < card s → ∃ a b, a ∈ s ∧ b ∈ s ∧ a ≠ b :=
+begin
+  intro h,
+  induction s with a s nain ih₁,
+   {exact absurd h dec_trivial},
+   {induction s with b s nbin ih₂,
+    {exact absurd h dec_trivial},
+     clear ih₁ ih₂,
+     existsi a, existsi b, split,
+      {apply mem_insert},
+      split,
+      {apply mem_insert_of_mem _ !mem_insert},
+      {intro aeqb, subst a, exact absurd !mem_insert nain}}
+end
+
+theorem Sum_const_eq_card_mul (s : finset A) (n : nat) : (∑ x ∈ s, n) = card s * n :=
+begin
+  induction s with a s' H IH,
+    rewrite [Sum_empty, card_empty, zero_mul],
+    rewrite [Sum_insert_of_not_mem _ H, IH, card_insert_of_not_mem H, add.comm,
+             right_distrib, one_mul]
+end
+
+theorem Sum_one_eq_card (s : finset A) : (∑ x ∈ s, (1 : nat)) = card s :=
+eq.trans !Sum_const_eq_card_mul !mul_one
+
+section deceqB
+include deceqB
+
+theorem card_Union_of_disjoint (s : finset A) (f : A → finset B) :
+  (∀{a₁ a₂}, a₁ ∈ s → a₂ ∈ s → a₁ ≠ a₂ → f a₁ ∩ f a₂ = ∅) →
+    card (⋃ x ∈ s, f x) = ∑ x ∈ s, card (f x) :=
+finset.induction_on s
+  (assume H, by rewrite [Union_empty, Sum_empty, card_empty])
+  (take a s', assume H : a ∉ s',
+    assume IH,
+    assume H1 : ∀ {a₁ a₂ : A}, a₁ ∈ insert a s' → a₂ ∈ insert a s' → a₁ ≠ a₂ → f a₁ ∩ f a₂ = ∅,
+    have H2  : ∀ a₁ a₂ : A, a₁ ∈ s' → a₂ ∈ s' → a₁ ≠ a₂ → f a₁ ∩ f a₂ = ∅, from
+      take a₁ a₂, assume H3 H4 H5,
+      H1 (!mem_insert_of_mem H3) (!mem_insert_of_mem H4) H5,
+    have H6 : card (⋃ (x : A) ∈ s', f x) = ∑ (x : A) ∈ s', card (f x), from IH H2,
+    have H7 : ∀ x, x ∈ s' → f a ∩ f x = ∅, from
+      take x, assume xs',
+      have anex : a ≠ x, from assume aex, (eq.subst aex H) xs',
+      H1 !mem_insert (!mem_insert_of_mem xs') anex,
+    have H8 : f a ∩ (⋃ (x : A) ∈ s', f x) = ∅, from
+      calc
+        f a ∩ (⋃ (x : A) ∈ s', f x) = (⋃ (x : A) ∈ s', f a ∩ f x)  : by rewrite inter_Union
+                                ... = (⋃ (x : A) ∈ s', ∅)          : by rewrite [Union_ext H7]
+                                ... = ∅                            : by rewrite Union_empty',
+    by rewrite [Union_insert, Sum_insert_of_not_mem _ H,
+                card_union_of_disjoint H8, H6])
+end deceqB
+
+lemma dvd_Sum_of_dvd (f : A → nat) (n : nat) (s : finset A) : (∀ a, a ∈ s → n ∣ f a) → n ∣ Sum s f :=
+begin
+  induction s with a s nain ih,
+   {intros, rewrite [Sum_empty], apply dvd_zero},
+   {intro h,
+    have h₁ : ∀ a, a ∈ s → n ∣ f a, from
+      take a, assume ains, h a (mem_insert_of_mem _ ains),
+    have h₂ : n ∣ Sum s f, from ih h₁,
+    have h₃ : n ∣ f a, from h a !mem_insert,
+    rewrite [Sum_insert_of_not_mem f nain],
+    apply dvd_add h₃ h₂}
+end
+end finset

old_library/data/finset/comb.lean

@@ -0,0 +1,487 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura, Jeremy Avigad
+
+Combinators for finite sets.
+-/
+import data.finset.basic logic.identities
+open list quot subtype decidable perm function
+
+namespace finset
+
+/- image (corresponds to map on list) -/
+section image
+variables {A B : Type}
+variable [h : decidable_eq B]
+include h
+
+definition image (f : A → B) (s : finset A) : finset B :=
+quot.lift_on s
+  (λ l, to_finset (list.map f (elt_of l)))
+  (λ l₁ l₂ p, quot.sound (perm_erase_dup_of_perm (perm_map _ p)))
+
+infix [priority finset.prio] `'` := image
+
+theorem image_empty (f : A → B) : image f ∅ = ∅ :=
+rfl
+
+theorem mem_image_of_mem (f : A → B) {s : finset A} {a : A} : a ∈ s → f a ∈ image f s :=
+quot.induction_on s (take l, assume H : a ∈ elt_of l, mem_to_finset (mem_map f H))
+
+theorem mem_image {f : A → B} {s : finset A} {a : A} {b : B}
+    (H1 : a ∈ s) (H2 : f a = b) :
+  b ∈ image f s :=
+eq.subst H2 (mem_image_of_mem f H1)
+
+theorem exists_of_mem_image {f : A → B} {s : finset A} {b : B} :
+  b ∈ image f s → ∃a, a ∈ s ∧ f a = b :=
+quot.induction_on s
+  (take l, assume H : b ∈ erase_dup (list.map f (elt_of l)),
+    exists_of_mem_map (mem_of_mem_erase_dup H))
+
+theorem mem_image_iff (f : A → B) {s : finset A} {y : B} : y ∈ image f s ↔ ∃x, x ∈ s ∧ f x = y :=
+iff.intro exists_of_mem_image
+  (assume H,
+    obtain x (H₁ : x ∈ s) (H₂ : f x = y), from H,
+    mem_image H₁ H₂)
+
+theorem mem_image_eq (f : A → B) {s : finset A} {y : B} : y ∈ image f s = ∃x, x ∈ s ∧ f x = y :=
+propext (mem_image_iff f)
+
+theorem mem_image_of_mem_image_of_subset {f : A → B} {s t : finset A} {y : B}
+    (H1 : y ∈ image f s) (H2 : s ⊆ t) : y ∈ image f t :=
+obtain x (H3: x ∈ s) (H4 : f x = y), from exists_of_mem_image H1,
+have H5 : x ∈ t, from mem_of_subset_of_mem H2 H3,
+show y ∈ image f t, from mem_image H5 H4
+
+theorem image_insert [h' : decidable_eq A] (f : A → B) (s : finset A) (a : A) :
+  image f (insert a s) = insert (f a) (image f s) :=
+ext (take y, iff.intro
+  (assume H : y ∈ image f (insert a s),
+    obtain x (H1l : x ∈ insert a s) (H1r :f x = y), from exists_of_mem_image H,
+    have x = a ∨ x ∈ s, from eq_or_mem_of_mem_insert H1l,
+    or.elim this
+      (suppose x = a,
+        have f a = y, from eq.subst this H1r,
+        show y ∈ insert (f a) (image f s), from eq.subst this !mem_insert)
+      (suppose x ∈ s,
+        have f x ∈ image f s, from mem_image_of_mem f this,
+        show y ∈ insert (f a) (image f s), from eq.subst H1r (mem_insert_of_mem _ this)))
+  (suppose y ∈ insert (f a) (image f s),
+    have y = f a ∨ y ∈ image f s, from eq_or_mem_of_mem_insert this,
+    or.elim this
+      (suppose y = f a,
+        have f a ∈ image f (insert a s), from mem_image_of_mem f !mem_insert,
+        show y ∈ image f (insert a s), from eq.subst (eq.symm `y = f a`) this)
+      (suppose y ∈ image f s,
+        show y ∈ image f (insert a s), from mem_image_of_mem_image_of_subset this !subset_insert)))
+
+lemma image_comp {C : Type} [deceqC : decidable_eq C] {f : B → C} {g : A → B} {s : finset A} :
+  image (f∘g) s = image f (image g s) :=
+ext (take z, iff.intro
+  (suppose z ∈ image (f∘g) s,
+    obtain x (Hx : x ∈ s) (Hgfx : f (g x) = z), from exists_of_mem_image this,
+    by rewrite -Hgfx; apply mem_image_of_mem _ (mem_image_of_mem _ Hx))
+  (suppose z ∈ image f (image g s),
+    obtain y (Hy : y ∈ image g s) (Hfy : f y = z), from exists_of_mem_image this,
+    obtain x (Hx : x ∈ s) (Hgx : g x = y), from exists_of_mem_image Hy,
+    mem_image Hx (by esimp; rewrite [Hgx, Hfy])))
+
+lemma image_subset {a b : finset A} (f : A → B) (H : a ⊆ b) : f ' a ⊆ f ' b :=
+subset_of_forall
+  (take y, assume Hy : y ∈ f ' a,
+    obtain x (Hx₁ : x ∈ a) (Hx₂ : f x = y), from exists_of_mem_image Hy,
+    mem_image (mem_of_subset_of_mem H Hx₁) Hx₂)
+
+theorem image_union [h' : decidable_eq A] (f : A → B) (s t : finset A) :
+  image f (s ∪ t) = image f s ∪ image f t :=
+ext (take y, iff.intro
+  (assume H : y ∈ image f (s ∪ t),
+    obtain x [(xst : x ∈ s ∪ t) (fxy : f x = y)], from exists_of_mem_image H,
+    or.elim (mem_or_mem_of_mem_union xst)
+      (assume xs, mem_union_l (mem_image xs fxy))
+      (assume xt, mem_union_r (mem_image xt fxy)))
+  (assume H : y ∈ image f s ∪ image f t,
+    or.elim (mem_or_mem_of_mem_union H)
+      (assume yifs : y ∈ image f s,
+        obtain x [(xs : x ∈ s) (fxy : f x = y)], from exists_of_mem_image yifs,
+        mem_image (mem_union_l xs) fxy)
+      (assume yift : y ∈ image f t,
+        obtain x [(xt : x ∈ t) (fxy : f x = y)], from exists_of_mem_image yift,
+        mem_image (mem_union_r xt) fxy)))
+end image
+
+/- separation and set-builder notation -/
+section sep
+variables {A : Type} [deceq : decidable_eq A]
+include deceq
+variables (p : A → Prop) [decp : decidable_pred p] (s : finset A) {x : A}
+include decp
+
+definition sep : finset A :=
+quot.lift_on s
+  (λl, to_finset_of_nodup
+    (list.filter p (subtype.elt_of l))
+    (list.nodup_filter p (subtype.has_property l)))
+  (λ l₁ l₂ u, quot.sound (perm.perm_filter u))
+
+notation [priority finset.prio] `{` binder ` ∈ ` s ` | ` r:(scoped:1 p, sep p s) `}` := r
+
+theorem sep_empty : sep p ∅ = ∅ := rfl
+
+variables {p s}
+
+theorem of_mem_sep : x ∈ sep p s → p x :=
+quot.induction_on s (take l, list.of_mem_filter)
+
+theorem mem_of_mem_sep : x ∈ sep p s → x ∈ s :=
+quot.induction_on s (take l, list.mem_of_mem_filter)
+
+theorem mem_sep_of_mem {x : A} : x ∈ s → p x → x ∈ sep p s :=
+quot.induction_on s (take l, list.mem_filter_of_mem)
+
+variables (p s)
+
+theorem mem_sep_iff : x ∈ sep p s ↔ x ∈ s ∧ p x :=
+iff.intro
+  (assume H, and.intro (mem_of_mem_sep H) (of_mem_sep H))
+  (assume H, mem_sep_of_mem (and.left H) (and.right H))
+
+theorem mem_sep_eq : x ∈ sep p s = (x ∈ s ∧ p x) :=
+propext !mem_sep_iff
+
+variable t : finset A
+
+theorem mem_sep_union_iff : x ∈ sep p (s ∪ t) ↔ x ∈ sep p s ∨ x ∈ sep p t :=
+by rewrite [*mem_sep_iff, mem_union_iff, and.right_distrib]
+
+end sep
+
+section
+
+variables {A : Type} [deceqA : decidable_eq A]
+include deceqA
+
+theorem eq_sep_of_subset {s t : finset A} (ssubt : s ⊆ t) : s = {x ∈ t | x ∈ s} :=
+ext (take x, iff.intro
+  (suppose x ∈ s, mem_sep_of_mem (mem_of_subset_of_mem ssubt this) this)
+  (suppose x ∈ {x ∈ t | x ∈ s}, of_mem_sep this))
+
+end
+
+/- set difference -/
+section diff
+variables {A : Type} [deceq : decidable_eq A]
+include deceq
+
+definition diff (s t : finset A) : finset A := {x ∈ s | x ∉ t}
+infix [priority finset.prio] ` \ `:70 := diff
+
+theorem mem_of_mem_diff {s t : finset A} {x : A} (H : x ∈ s \ t) : x ∈ s :=
+mem_of_mem_sep H
+
+theorem not_mem_of_mem_diff {s t : finset A} {x : A} (H : x ∈ s \ t) : x ∉ t :=
+of_mem_sep H
+
+theorem mem_diff {s t : finset A} {x : A} (H1 : x ∈ s) (H2 : x ∉ t) : x ∈ s \ t :=
+mem_sep_of_mem H1 H2
+
+theorem mem_diff_iff (s t : finset A) (x : A) : x ∈ s \ t ↔ x ∈ s ∧ x ∉ t :=
+iff.intro
+  (assume H, and.intro (mem_of_mem_diff H) (not_mem_of_mem_diff H))
+  (assume H, mem_diff (and.left H) (and.right H))
+
+theorem mem_diff_eq (s t : finset A) (x : A) : x ∈ s \ t = (x ∈ s ∧ x ∉ t) :=
+propext !mem_diff_iff
+
+theorem union_diff_cancel {s t : finset A} (H : s ⊆ t) : s ∪ (t \ s) = t :=
+ext (take x, iff.intro
+  (suppose x ∈ s ∪ (t \ s),
+    or.elim (mem_or_mem_of_mem_union this)
+      (suppose x ∈ s, mem_of_subset_of_mem H this)
+      (suppose x ∈ t \ s, mem_of_mem_diff this))
+  (suppose x ∈ t,
+    decidable.by_cases
+      (suppose x ∈ s, mem_union_left _ this)
+      (suppose x ∉ s, mem_union_right _ (mem_diff `x ∈ t` this))))
+
+theorem diff_union_cancel {s t : finset A} (H : s ⊆ t) : (t \ s) ∪ s = t :=
+eq.subst !union_comm (!union_diff_cancel H)
+end diff
+
+/- set complement -/
+section complement
+
+variables {A : Type} [deceqA : decidable_eq A] [h : fintype A]
+include deceqA h
+
+definition compl (s : finset A) : finset A := univ \ s
+prefix [priority finset.prio] - := compl
+
+theorem mem_compl {s : finset A} {x : A} (H : x ∉ s) : x ∈ -s :=
+mem_diff !mem_univ H
+
+theorem not_mem_of_mem_compl {s : finset A} {x : A} (H : x ∈ -s) : x ∉ s :=
+not_mem_of_mem_diff H
+
+theorem mem_compl_iff (s : finset A) (x : A) : x ∈ -s ↔ x ∉ s :=
+iff.intro not_mem_of_mem_compl mem_compl
+
+section
+  local attribute classical.prop_decidable [instance]
+
+  theorem union_eq_compl_compl_inter_compl (s t : finset A) : s ∪ t = -(-s ∩ -t) :=
+  ext (take x, by rewrite [mem_union_iff, mem_compl_iff, mem_inter_iff, *mem_compl_iff,
+                           or_iff_not_and_not])
+
+  theorem inter_eq_compl_compl_union_compl (s t : finset A) : s ∩ t = -(-s ∪ -t) :=
+  ext (take x, by rewrite [mem_inter_iff, mem_compl_iff, mem_union_iff, *mem_compl_iff,
+                           and_iff_not_or_not])
+end
+
+end complement
+
+/- all -/
+section all
+variables {A : Type}
+definition all (s : finset A) (p : A → Prop) : Prop :=
+quot.lift_on s
+  (λ l, all (elt_of l) p)
+  (λ l₁ l₂ p, foldr_eq_of_perm (λ a₁ a₂ q, propext !and.left_comm) p true)
+
+theorem all_empty (p : A → Prop) : all ∅ p = true :=
+rfl
+
+theorem of_mem_of_all {p : A → Prop} {a : A} {s : finset A} : a ∈ s → all s p → p a :=
+quot.induction_on s (λ l i h, list.of_mem_of_all i h)
+
+theorem forall_of_all {p : A → Prop} {s : finset A} (H : all s p) : ∀{a}, a ∈ s → p a :=
+λ a H', of_mem_of_all H' H
+
+theorem all_of_forall {p : A → Prop} {s : finset A} : (∀a, a ∈ s → p a) → all s p :=
+quot.induction_on s (λ l H, list.all_of_forall H)
+
+theorem all_iff_forall (p : A → Prop) (s : finset A) : all s p ↔ (∀a, a ∈ s → p a) :=
+iff.intro forall_of_all all_of_forall
+
+attribute [instance]
+definition decidable_all (p : A → Prop) [h : decidable_pred p] (s : finset A) :
+  decidable (all s p) :=
+quot.rec_on_subsingleton s (λ l, list.decidable_all p (elt_of l))
+
+theorem all_implies {p q : A → Prop} {s : finset A} : all s p → (∀ x, p x → q x) → all s q :=
+quot.induction_on s (λ l h₁ h₂, list.all_implies h₁ h₂)
+
+variable [h : decidable_eq A]
+include h
+
+theorem all_union {p : A → Prop} {s₁ s₂ : finset A} :  all s₁ p → all s₂ p → all (s₁ ∪ s₂) p :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ a₁ a₂, all_union a₁ a₂)
+
+theorem all_of_all_union_left {p : A → Prop} {s₁ s₂ : finset A} : all (s₁ ∪ s₂) p → all s₁ p :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ a, list.all_of_all_union_left a)
+
+theorem all_of_all_union_right {p : A → Prop} {s₁ s₂ : finset A} : all (s₁ ∪ s₂) p → all s₂ p :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ a, list.all_of_all_union_right a)
+
+theorem all_insert_of_all {p : A → Prop} {a : A} {s : finset A} : p a → all s p → all (insert a s) p :=
+quot.induction_on s (λ l h₁ h₂, list.all_insert_of_all h₁ h₂)
+
+theorem all_erase_of_all {p : A → Prop} (a : A) {s : finset A}: all s p → all (erase a s) p :=
+quot.induction_on s (λ l h, list.all_erase_of_all a h)
+
+theorem all_inter_of_all_left {p : A → Prop} {s₁ : finset A} (s₂ : finset A) : all s₁ p → all (s₁ ∩ s₂) p :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ h, list.all_inter_of_all_left _ h)
+
+theorem all_inter_of_all_right {p : A → Prop} {s₁ : finset A} (s₂ : finset A) : all s₂ p → all (s₁ ∩ s₂) p :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ h, list.all_inter_of_all_right _ h)
+
+theorem subset_iff_all (s t : finset A) : s ⊆ t ↔ all s (λ x, x ∈ t) :=
+iff.intro
+  (suppose s ⊆ t, all_of_forall (take x, suppose x ∈ s, mem_of_subset_of_mem `s ⊆ t` `x ∈ s`))
+  (suppose all s (λ x, x ∈ t), subset_of_forall (take x, suppose x ∈ s, of_mem_of_all `x ∈ s` `all s (λ x, x ∈ t)`))
+
+attribute [instance]
+definition decidable_subset (s t : finset A) : decidable (s ⊆ t) :=
+decidable_of_decidable_of_iff _ (iff.symm !subset_iff_all)
+end all
+
+/- any -/
+section any
+variables {A : Type}
+definition any (s : finset A) (p : A → Prop) : Prop :=
+quot.lift_on s
+  (λ l, any (elt_of l) p)
+  (λ l₁ l₂ p, foldr_eq_of_perm (λ a₁ a₂ q, propext !or.left_comm) p false)
+
+theorem any_empty (p : A → Prop) : any ∅ p = false := rfl
+
+theorem exists_of_any {p : A → Prop} {s : finset A} : any s p → ∃a, a ∈ s ∧ p a :=
+quot.induction_on s (λ l H, list.exists_of_any H)
+
+theorem any_of_mem {p : A → Prop} {s : finset A} {a : A} : a ∈ s → p a → any s p :=
+quot.induction_on s (λ l H1 H2, list.any_of_mem H1 H2)
+
+theorem any_of_exists {p : A → Prop} {s : finset A} (H : ∃a, a ∈ s ∧ p a) : any s p :=
+obtain a H₁ H₂, from H,
+any_of_mem H₁ H₂
+
+theorem any_iff_exists (p : A → Prop) (s : finset A) : any s p ↔ (∃a, a ∈ s ∧ p a) :=
+iff.intro exists_of_any any_of_exists
+
+theorem any_of_insert [h : decidable_eq A] {p : A → Prop} (s : finset A) {a : A} (H : p a) :
+  any (insert a s) p :=
+any_of_mem (mem_insert a s) H
+
+theorem any_of_insert_right [h : decidable_eq A] {p : A → Prop} {s : finset A} (a : A) (H : any s p) :
+  any (insert a s) p :=
+obtain b (H₁ : b ∈ s) (H₂ : p b), from exists_of_any H,
+any_of_mem (mem_insert_of_mem a H₁) H₂
+
+attribute [instance]
+definition decidable_any (p : A → Prop) [h : decidable_pred p] (s : finset A) :
+  decidable (any s p) :=
+quot.rec_on_subsingleton s (λ l, list.decidable_any p (elt_of l))
+end any
+
+section product
+variables {A B : Type}
+definition product (s₁ : finset A) (s₂ : finset B) : finset (A × B) :=
+quot.lift_on₂ s₁ s₂
+  (λ l₁ l₂,
+    to_finset_of_nodup (product (elt_of l₁) (elt_of l₂))
+                       (nodup_product (has_property l₁) (has_property l₂)))
+  (λ v₁ v₂ w₁ w₂ p₁ p₂, begin apply @quot.sound, apply perm_product p₁ p₂ end)
+
+infix [priority finset.prio] * := product
+
+theorem empty_product (s : finset B) : @empty A * s = ∅ :=
+quot.induction_on s (λ l, rfl)
+
+theorem mem_product {a : A} {b : B} {s₁ : finset A} {s₂ : finset B}
+        : a ∈ s₁ → b ∈ s₂ → (a, b) ∈ s₁ * s₂ :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ i₁ i₂, list.mem_product i₁ i₂)
+
+theorem mem_of_mem_product_left {a : A} {b : B} {s₁ : finset A} {s₂ : finset B}
+        : (a, b) ∈ s₁ * s₂ → a ∈ s₁ :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ i, list.mem_of_mem_product_left i)
+
+theorem mem_of_mem_product_right {a : A} {b : B} {s₁ : finset A} {s₂ : finset B}
+        : (a, b) ∈ s₁ * s₂ → b ∈ s₂ :=
+quot.induction_on₂ s₁ s₂ (λ l₁ l₂ i, list.mem_of_mem_product_right i)
+
+theorem product_empty (s : finset A) : s * @empty B = ∅ :=
+ext (λ p,
+  match p with
+  | (a, b) := iff.intro
+     (λ i, absurd (mem_of_mem_product_right i) !not_mem_empty)
+     (λ i, absurd i !not_mem_empty)
+  end)
+end product
+
+/- powerset -/
+section powerset
+variables {A : Type} [deceqA : decidable_eq A]
+include deceqA
+
+  section list_powerset
+  open list
+
+  definition list_powerset : list A → finset (finset A)
+  | []       := '{∅}
+  | (a :: l) := list_powerset l ∪ image (insert a) (list_powerset l)
+
+  end list_powerset
+
+private theorem image_insert_comm (a b : A) (s : finset (finset A)) :
+  image (insert a) (image (insert b) s) = image (insert b) (image (insert a) s) :=
+have aux' : ∀ a b : A, ∀ x : finset A,
+  x ∈ image (insert a) (image (insert b) s) →
+    x ∈ image (insert b) (image (insert a) s), from
+  begin
+    intros [a, b, x, H],
+    cases (exists_of_mem_image H) with [y, Hy],
+    cases Hy with [Hy1, Hy2],
+    cases (exists_of_mem_image Hy1) with [z, Hz],
+    cases Hz with [Hz1, Hz2],
+    substvars,
+    rewrite insert.comm,
+    repeat (apply mem_image_of_mem),
+    assumption
+  end,
+ext (take x, iff.intro (aux' a b x) (aux' b a x))
+
+theorem list_powerset_eq_list_powerset_of_perm {l₁ l₂ : list A} (p : l₁ ~ l₂) :
+    list_powerset l₁ = list_powerset l₂ :=
+perm.induction_on p
+  rfl
+  (λ x l₁ l₂ p ih, by rewrite [↑list_powerset, ih])
+  (λ x y l, by rewrite [↑list_powerset, ↑list_powerset, *image_union, image_insert_comm,
+                        *union_assoc, union_left_comm (finset.image (finset.insert x) _)])
+  (λ l₁ l₂ l₃ p₁ p₂ r₁ r₂, eq.trans r₁ r₂)
+
+definition powerset (s : finset A) : finset (finset A) :=
+quot.lift_on s
+  (λ l, list_powerset (elt_of l))
+  (λ l₁ l₂ p, list_powerset_eq_list_powerset_of_perm p)
+
+prefix [priority finset.prio] `𝒫`:100 := powerset
+
+theorem powerset_empty : 𝒫 (∅ : finset A) = '{∅} := rfl
+
+theorem powerset_insert {a : A} {s : finset A} : a ∉ s → 𝒫 (insert a s) = 𝒫 s ∪ image (insert a) (𝒫 s) :=
+quot.induction_on s
+  (λ l,
+    assume H : a ∉ quot.mk l,
+    calc
+      𝒫 (insert a (quot.mk l))
+            = list_powerset (list.insert a (elt_of l)) : rfl
+        ... = list_powerset (#list a :: elt_of l)       : by rewrite [list.insert_eq_of_not_mem H]
+        ... = 𝒫 (quot.mk l) ∪ image (insert a) (𝒫 (quot.mk l)) : rfl)
+
+theorem mem_powerset_iff_subset (s : finset A) : ∀ x, x ∈ 𝒫 s ↔ x ⊆ s :=
+begin
+  induction s with a s nains ih,
+    intro x,
+    rewrite powerset_empty,
+    show x ∈ '{∅} ↔ x ⊆ ∅, by rewrite [mem_singleton_iff, subset_empty_iff],
+  intro x,
+    rewrite [powerset_insert nains, mem_union_iff, ih, mem_image_iff],
+    exact
+      (iff.intro
+        (assume H,
+          or.elim H
+            (suppose x ⊆ s, subset.trans this !subset_insert)
+            (suppose ∃ y, y ∈ 𝒫 s ∧ insert a y = x,
+              obtain y [yps iay], from this,
+              show x ⊆ insert a s,
+                begin
+                  rewrite [-iay],
+                  apply insert_subset_insert,
+                  rewrite -ih,
+                  apply yps
+                end))
+        (assume H : x ⊆ insert a s,
+          have H' : erase a x ⊆ s, from erase_subset_of_subset_insert H,
+          decidable.by_cases
+            (suppose a ∈ x,
+              or.inr (exists.intro (erase a x)
+                (and.intro
+                  (show erase a x ∈ 𝒫 s, by rewrite ih; apply H')
+                  (show insert a (erase a x) = x, from insert_erase this))))
+            (suppose a ∉ x, or.inl
+              (show x ⊆ s, by rewrite [(erase_eq_of_not_mem this) at H']; apply H'))))
+end
+
+theorem subset_of_mem_powerset {s t : finset A} (H : s ∈ 𝒫 t) : s ⊆ t :=
+iff.mp (mem_powerset_iff_subset t s) H
+
+theorem mem_powerset_of_subset {s t : finset A} (H : s ⊆ t) : s ∈ 𝒫 t :=
+iff.mpr (mem_powerset_iff_subset t s) H
+
+theorem empty_mem_powerset (s : finset A) : ∅ ∈ 𝒫 s :=
+mem_powerset_of_subset (empty_subset s)
+
+end powerset
+end finset

old_library/data/finset/default.lean

@@ -0,0 +1,8 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+
+Finite sets.
+-/
+import .basic .comb .to_set .card .bigops .partition

old_library/data/finset/equiv.lean

@@ -0,0 +1,287 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+-/
+import data.finset.card
+open nat decidable
+
+namespace finset
+variable {A : Type}
+
+protected definition to_nat (s : finset nat) : nat :=
+finset.Sum s (λ n, 2^n)
+
+open finset (to_nat)
+
+lemma to_nat_empty : to_nat ∅ = 0 :=
+rfl
+
+lemma to_nat_insert {n : nat} {s : finset nat} : n ∉ s → to_nat (insert n s) = 2^n + to_nat s :=
+assume h, Sum_insert_of_not_mem _ h
+
+protected definition of_nat (s : nat) : finset nat :=
+{ n ∈ upto (succ s) | odd (s / 2^n) }
+
+open finset (of_nat)
+
+private lemma of_nat_zero : of_nat 0 = ∅ :=
+rfl
+
+private lemma odd_of_mem_of_nat {n : nat} {s : nat} : n ∈ of_nat s → odd (s / 2^n) :=
+assume h, of_mem_sep h
+
+private lemma mem_of_nat_of_odd {n : nat} {s : nat} : odd (s / 2^n) → n ∈ of_nat s :=
+assume h,
+have 2^n < succ s, from by_contradiction
+  (suppose ¬(2^n < succ s),
+   have 2^n > s, from lt_of_succ_le (le_of_not_gt this),
+   have s / 2^n = 0, from div_eq_zero_of_lt this,
+   by rewrite this at h; exact absurd h dec_trivial),
+have n < succ s,        from calc
+   n   ≤ 2^n    : le_pow_self dec_trivial n
+   ... < succ s : this,
+have n ∈ upto (succ s), from mem_upto_of_lt this,
+mem_sep_of_mem this h
+
+private lemma succ_mem_of_nat (n : nat) (s : nat) : succ n ∈ of_nat s ↔ n ∈ of_nat (s / 2) :=
+iff.intro
+  (suppose succ n ∈ of_nat s,
+   have odd (s / 2^(succ n)),    from odd_of_mem_of_nat this,
+   have odd ((s / 2) / (2 ^ n)), by rewrite [pow_succ' at this, nat.div_div_eq_div_mul, mul.comm]; assumption,
+   show n ∈ of_nat (s / 2),        from mem_of_nat_of_odd this)
+  (suppose n ∈ of_nat (s / 2),
+   have odd ((s / 2) / (2 ^ n)), from odd_of_mem_of_nat this,
+   have odd (s / 2^(succ n)),      by rewrite [pow_succ', mul.comm, -nat.div_div_eq_div_mul]; assumption,
+   show succ n ∈ of_nat s,             from mem_of_nat_of_odd this)
+
+private lemma odd_of_zero_mem (s : nat) : 0 ∈ of_nat s ↔ odd s :=
+begin
+  unfold of_nat, rewrite [mem_sep_eq, pow_zero, nat.div_one, mem_upto_eq],
+  show 0 < succ s ∧ odd s ↔ odd s, from
+  iff.intro
+    (assume h, and.right h)
+    (assume h, and.intro (zero_lt_succ s) h)
+end
+
+private lemma even_of_not_zero_mem (s : nat) : 0 ∉ of_nat s ↔ even s :=
+have aux : 0 ∉ of_nat s ↔ ¬odd s, from not_iff_not_of_iff (odd_of_zero_mem s),
+iff.intro
+  (suppose 0 ∉ of_nat s, even_of_not_odd (iff.mp aux this))
+  (suppose even s, iff.mpr aux (not_odd_of_even this))
+
+private lemma even_to_nat (s : finset nat) : even (to_nat s) ↔ 0 ∉ s :=
+finset.induction_on s dec_trivial
+  (λ a s nains ih,
+    begin
+      rewrite [to_nat_insert nains], apply iff.intro,
+        suppose even (2^a + to_nat s), by_cases
+          (suppose e : even (2^a), by_cases
+            (suppose even (to_nat s),
+              have 0 ∉ s, from iff.mp ih this,
+              suppose 0 ∈ insert a s, or.elim (eq_or_mem_of_mem_insert this)
+                (suppose 0 = a, begin rewrite [-this at e], exact absurd e not_even_one end)
+                (by contradiction))
+            (suppose odd  (to_nat s), absurd `even (2^a + to_nat s)` (odd_add_of_even_of_odd `even (2^a)` this)))
+          (suppose o : odd (2^a), by_cases
+            (suppose even (to_nat s), absurd `even (2^a + to_nat s)` (odd_add_of_odd_of_even `odd (2^a)` this))
+            (suppose odd  (to_nat s), suppose 0 ∈ insert a s, or.elim (eq_or_mem_of_mem_insert this)
+              (suppose 0 = a,
+                have even (to_nat s), from iff.mpr ih (by rewrite -this at nains; exact nains),
+                absurd this `odd (to_nat s)`)
+              (suppose 0 ∈ s,
+                have a ≠ 0, from suppose a = 0, by subst a; contradiction,
+                begin
+                  cases a with a, exact absurd rfl `0 ≠ 0`,
+                  have odd (2*2^a),  by rewrite [pow_succ' at o, mul.comm]; exact o,
+                  have even (2*2^a), from !even_two_mul,
+                  exact absurd `even (2*2^a)` `odd (2*2^a)`
+                end))),
+        suppose 0 ∉ insert a s,
+          have a ≠ 0, from suppose a = 0, absurd (by rewrite this; apply mem_insert) `0 ∉ insert a s`,
+          have 0 ∉ s, from suppose 0 ∈ s, absurd (mem_insert_of_mem _ this) `0 ∉ insert a s`,
+          have even (to_nat s), from iff.mpr ih this,
+          match a with
+          | 0         := suppose a = 0, absurd this `a ≠ 0`
+          | (succ a') := suppose a = succ a',
+            have even (2^(succ a')), by rewrite [pow_succ', mul.comm]; apply even_two_mul,
+            even_add_of_even_of_even this `even (to_nat s)`
+          end rfl
+    end)
+
+private lemma of_nat_eq_insert_zero {s : nat} : 0 ∉ of_nat s → of_nat (2^0 + s) = insert 0 (of_nat s) :=
+assume h : 0 ∉ of_nat s,
+have even s,                  from iff.mp (even_of_not_zero_mem s) h,
+have   odd (s+1),               from odd_succ_of_even this,
+have zmem : 0 ∈ of_nat (s+1), from iff.mpr (odd_of_zero_mem (s+1)) this,
+obtain w (hw : s = 2*w),        from exists_of_even `even s`,
+begin
+  rewrite [pow_zero, add.comm, hw],
+  show of_nat (2*w+1) = insert 0 (of_nat (2*w)), from
+  finset.ext (λ n,
+    match n with
+    | 0      := iff.intro (λ h, !mem_insert) (λ h, by rewrite [hw at zmem]; exact zmem)
+    | succ m :=
+       have d₁  : 1 / 2 = (0:nat),  from dec_trivial,
+       have aux : _, from calc
+         succ m ∈ of_nat (2 * w + 1) ↔ m ∈ of_nat ((2*w+1) / 2) : succ_mem_of_nat
+                  ...                ↔ m ∈ of_nat w             : by rewrite [add.comm, add_mul_div_self_left _ _ (dec_trivial : 2 > 0), d₁, zero_add]
+                  ...                ↔ m ∈ of_nat (2*w / 2)     : by rewrite [mul.comm, nat.mul_div_cancel _ (dec_trivial : 2 > 0)]
+                  ...                ↔ succ m ∈ of_nat (2*w)    : succ_mem_of_nat,
+       iff.intro
+         (λ hl, finset.mem_insert_of_mem _ (iff.mp aux hl))
+         (λ hr, or.elim (eq_or_mem_of_mem_insert hr)
+           (by contradiction)
+           (iff.mpr aux))
+    end)
+end
+
+private lemma of_nat_eq_insert : ∀ {n s : nat}, n ∉ of_nat s → of_nat (2^n + s) = insert n (of_nat s)
+| 0        s h := of_nat_eq_insert_zero h
+| (succ n) s h :=
+  have n ∉ of_nat (s / 2),
+    from iff.mp (not_iff_not_of_iff !succ_mem_of_nat) h,
+  have ih : of_nat (2^n + s / 2) = insert n (of_nat (s / 2)), from of_nat_eq_insert this,
+  finset.ext (λ x,
+  have gen : ∀ m, m ∈ of_nat (2^(succ n) + s) ↔ m ∈ insert (succ n) (of_nat s)
+  | zero     :=
+    have even (2^(succ n)), by rewrite [pow_succ', mul.comm]; apply even_two_mul,
+    have aux₁ : odd (2^(succ n) + s) ↔ odd s, from iff.intro
+      (suppose odd (2^(succ n) + s), by_contradiction
+        (suppose ¬ odd s,
+         have even s,                from even_of_not_odd this,
+         have even (2^(succ n) + s), from even_add_of_even_of_even `even (2^(succ n))` this,
+         absurd `odd (2^(succ n) + s)` (not_odd_of_even this)))
+      (suppose odd s, odd_add_of_even_of_odd `even (2^(succ n))` this),
+    have aux₂ : odd s ↔ 0 ∈ insert (succ n) (of_nat s), from iff.intro
+      (suppose odd s, finset.mem_insert_of_mem _ (iff.mpr !odd_of_zero_mem this))
+      (suppose 0 ∈ insert (succ n) (of_nat s), or.elim (eq_or_mem_of_mem_insert this)
+         (by contradiction)
+         (suppose 0 ∈ of_nat s, iff.mp !odd_of_zero_mem this)),
+    calc
+      0 ∈ of_nat (2^(succ n) + s) ↔ odd (2^(succ n) + s)           : odd_of_zero_mem
+                             ...  ↔ odd s                          : aux₁
+                             ...  ↔ 0 ∈ insert (succ n) (of_nat s) : aux₂
+  | (succ m) :=
+    have aux : m ∈ insert n (of_nat (s / 2)) ↔ succ m ∈ insert (succ n) (of_nat s), from iff.intro
+      (assume hl, or.elim (eq_or_mem_of_mem_insert hl)
+        (suppose m = n,                by subst m; apply mem_insert)
+        (suppose m ∈ of_nat (s / 2), finset.mem_insert_of_mem _ (iff.mpr !succ_mem_of_nat this)))
+      (assume hr, or.elim (eq_or_mem_of_mem_insert hr)
+        (suppose succ m = succ n,
+         have m = n, by injection this; assumption,
+         by subst m; apply mem_insert)
+        (suppose succ m ∈ of_nat s, finset.mem_insert_of_mem _ (iff.mp !succ_mem_of_nat this))),
+    calc
+      succ m ∈ of_nat (2^(succ n) + s) ↔ succ m ∈ of_nat (2^n * 2 + s)       : by rewrite pow_succ'
+                                 ...   ↔ m ∈ of_nat ((2^n * 2 + s) / 2)      : succ_mem_of_nat
+                                 ...   ↔ m ∈ of_nat (2^n + s / 2)            : by rewrite [add.comm, add_mul_div_self (dec_trivial : 2 > 0), add.comm]
+                                 ...   ↔ m ∈ insert n (of_nat (s / 2))       : by rewrite ih
+                                 ...   ↔ succ m ∈ insert (succ n) (of_nat s) : aux,
+  gen x)
+
+lemma of_nat_to_nat (s : finset nat) : of_nat (to_nat s) = s :=
+finset.induction_on s rfl
+  (λ a s nains ih, by rewrite [to_nat_insert nains, -ih at nains, of_nat_eq_insert nains, ih])
+
+private definition predimage (s : finset nat) : finset nat :=
+{ n ∈ image pred s | succ n ∈ s }
+
+private lemma mem_image_pred_of_succ_mem {n : nat} {s : finset nat} : succ n ∈ s → n ∈ image pred s :=
+assume h,
+  have pred (succ n) ∈ image pred s, from mem_image_of_mem _ h,
+  begin rewrite [pred_succ at this], assumption end
+
+private lemma mem_predimage_of_succ_mem {n : nat} {s : finset nat} : succ n ∈ s → n ∈ predimage s :=
+assume h, begin unfold predimage, rewrite [mem_sep_eq], exact and.intro (mem_image_pred_of_succ_mem h) h end
+
+private lemma succ_mem_of_mem_predimage {n : nat} {s : finset nat} : n ∈ predimage s → succ n ∈ s :=
+begin
+  unfold predimage, rewrite [mem_sep_eq],
+  suppose n ∈ image pred s ∧ succ n ∈ s, and.right this
+end
+
+private lemma predimage_insert_zero (s : finset nat) : predimage (insert 0 s) = predimage s :=
+finset.ext (λ n,
+  begin
+    unfold predimage, rewrite [*mem_sep_eq, image_insert, pred_zero], apply iff.intro,
+    suppose n ∈ insert 0 (image pred s) ∧ succ n ∈ insert 0 s,
+      have succ n ∈ s, from or.elim (eq_or_mem_of_mem_insert (and.right this))
+        (by contradiction)
+        (λ h, h),
+      and.intro (mem_image_pred_of_succ_mem this) this,
+    suppose n ∈ image pred s ∧ succ n ∈ s,
+      obtain h₁ h₂, from this,
+      and.intro (mem_insert_of_mem 0 h₁) (mem_insert_of_mem 0 h₂)
+  end)
+
+private lemma predimage_insert_succ (n : nat) (s : finset nat) : predimage (insert (succ n) s) = insert n (predimage s) :=
+finset.ext (λ m,
+  begin
+    unfold predimage, rewrite [*mem_sep_eq, *image_insert, pred_succ, *mem_insert_eq, *mem_sep_eq], apply iff.intro,
+      suppose (m = n ∨ m ∈ image pred s) ∧ (succ m = succ n ∨ succ m ∈ s),
+        obtain h₁ h₂, from this,
+        or.elim h₁
+          (suppose m = n, or.inl this)
+          (suppose m ∈ image pred s, or.elim h₂
+            (suppose succ m = succ n, by injection this; left; assumption)
+            (suppose succ m ∈ s, by right; split; repeat assumption)),
+      suppose m = n ∨ m ∈ image pred s ∧ succ m ∈ s, or.elim this
+        (suppose m = n, and.intro (or.inl this) (or.inl (by subst m)))
+        (suppose m ∈ image pred s ∧ succ m ∈ s,
+          obtain h₁ h₂, from this,
+          and.intro (or.inr h₁) (or.inr h₂))
+  end)
+
+private lemma of_nat_div2 (s : nat) : of_nat (s / 2) = predimage (of_nat s) :=
+finset.ext (λ n, iff.intro
+  (suppose n ∈ of_nat (s / 2),
+   have succ n ∈ of_nat s, from iff.mpr !succ_mem_of_nat this,
+   mem_predimage_of_succ_mem this)
+  (suppose n ∈ predimage (of_nat s),
+   have succ n ∈ of_nat s, from succ_mem_of_mem_predimage this,
+   iff.mp !succ_mem_of_nat this))
+
+private lemma to_nat_predimage (s : finset nat) : to_nat (predimage s) = (to_nat s) / 2 :=
+begin
+  induction s with a s nains ih,
+   reflexivity,
+   cases a with a,
+   { rewrite [predimage_insert_zero, ih, to_nat_insert nains, pow_zero],
+     have 0 ∉ of_nat (to_nat s), begin rewrite of_nat_to_nat, exact nains end,
+     have even (to_nat s), from iff.mp !even_of_not_zero_mem this,
+     obtain (w : nat) (hw : to_nat s = 2*w), from exists_of_even this,
+     begin
+       rewrite hw,
+       have d₁ : 1 / 2 = (0:nat),          from dec_trivial,
+       show 2 * w / 2 = (1 + 2 * w) / 2, by
+         rewrite [add_mul_div_self_left _ _ (dec_trivial : 2 > 0), mul.comm,
+                  nat.mul_div_cancel _ (dec_trivial : 2 > 0), d₁, zero_add]
+     end },
+   { have a ∉ predimage s, from suppose a ∈ predimage s, absurd (succ_mem_of_mem_predimage this) nains,
+     rewrite [predimage_insert_succ, to_nat_insert nains, pow_succ', add.comm,
+              add_mul_div_self (dec_trivial : 2 > 0), -ih, to_nat_insert this, add.comm] }
+end
+
+lemma to_nat_of_nat (s : nat) : to_nat (of_nat s) = s :=
+nat.strong_induction_on s
+  (λ n ih, by_cases
+    (suppose n = 0, by rewrite this)
+    (suppose n ≠ 0,
+      have n / 2 < n, from div_lt_of_ne_zero this,
+      have to_nat (of_nat (n / 2)) = n / 2, from ih _ this,
+      have e₁ : to_nat (of_nat n) / 2 = n / 2, from calc
+        to_nat (of_nat n) / 2 = to_nat (predimage (of_nat n)) : by rewrite to_nat_predimage
+                          ...   = to_nat (of_nat (n / 2))     : by rewrite of_nat_div2
+                          ...   = n / 2                       : this,
+      have e₂ : even (to_nat (of_nat n)) ↔ even n, from calc
+        even (to_nat (of_nat n)) ↔ 0 ∉ of_nat n : even_to_nat
+                             ... ↔ even n       : even_of_not_zero_mem,
+      eq_of_div2_of_even e₁ e₂))
+
+open equiv
+
+definition finset_nat_equiv_nat : finset nat ≃ nat :=
+mk to_nat of_nat of_nat_to_nat to_nat_of_nat
+
+end finset

old_library/data/finset/finset.md

@@ -0,0 +1,11 @@
+data.finset
+===========
+
+Finite sets. By default, `import list` imports everything here.
+
+[basic](basic.lean) : basic operations and properties
+[comb](comb.lean) : combinators and list constructions
+[to_set](to_set.lean) : interactions with sets
+[card](card.lean) : cardinality
+[bigops](bigops.lean) : finite unions and intersections
+[partition](partition.lean) : partitions of a type into finsets

old_library/data/finset/partition.lean

@@ -0,0 +1,142 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Haitao Zhang
+
+Partitions of a type A into finite subsets of A. Such a partition is represented by
+a function f : A → finset A which maps every element a : A to its equivalence class.
+-/
+import .card
+open function eq.ops
+
+variable {A : Type}
+variable [deceqA : decidable_eq A]
+include deceqA
+
+namespace finset
+
+definition is_partition (f : A → finset A) := ∀ a b, a ∈ f b = (f a = f b)
+
+structure partition : Type :=
+(set : finset A) (part : A → finset A) (is_part : is_partition part)
+  (complete : set = Union set part)
+
+-- attribute partition.part [coercion]
+
+namespace partition
+
+definition equiv_classes (f : partition) : finset (finset A) :=
+image (partition.part f) (partition.set f)
+
+lemma equiv_class_disjoint (f : partition) (a1 a2 : finset A) (Pa1 : a1 ∈ equiv_classes f)
+    (Pa2 : a2 ∈ equiv_classes f) :
+  a1 ≠ a2 → a1 ∩ a2 = ∅ :=
+assume Pne,
+have Pe1 : _, from exists_of_mem_image Pa1, obtain g1 Pg1, from Pe1,
+have Pe2 : _, from exists_of_mem_image Pa2, obtain g2 Pg2, from Pe2,
+begin
+  apply inter_eq_empty_of_disjoint,
+  apply disjoint.intro,
+  rewrite [eq.symm (and.right Pg1), eq.symm (and.right Pg2)],
+  intro x,
+  rewrite [*partition.is_part f],
+  intro Pxg1, rewrite [Pxg1, and.right Pg1, and.right Pg2],
+  intro Pe, exact absurd Pe Pne
+end
+open nat
+theorem class_equation (f : @partition A _) :
+  card (partition.set f) = finset.Sum (equiv_classes f) card :=
+let s := (partition.set f), p := (partition.part f), img := image p s in
+  calc
+    card s = card (Union s p) : partition.complete f
+       ... = card (Union img id) : image_eq_Union_index_image s p
+       ... = card (Union (equiv_classes f) id) : rfl
+       ... = finset.Sum (equiv_classes f) card : card_Union_of_disjoint _ id (equiv_class_disjoint f)
+
+lemma equiv_class_refl {f : A → finset A} (Pequiv : is_partition f) : ∀ a, a ∈ f a :=
+take a, by rewrite [Pequiv a a]
+
+-- make it a little easier to prove union from restriction
+lemma restriction_imp_union {s : finset A} (f : A → finset A) (Pequiv : is_partition f)
+    (Psub : ∀{a}, a ∈ s → f a ⊆ s) :
+  s = Union s f :=
+ext (take a, iff.intro
+  (assume Pains,
+    begin
+      rewrite [(Union_insert_of_mem f Pains)⁻¹, Union_insert],
+      apply mem_union_l, exact equiv_class_refl Pequiv a
+    end)
+  (assume Painu,
+    have Pclass : ∃ x, x ∈ s ∧ a ∈ f x,
+      from iff.elim_left (mem_Union_iff s f _) Painu,
+    obtain x Px, from Pclass,
+    have Pfx : f x ⊆ s, from Psub (and.left Px),
+    mem_of_subset_of_mem Pfx (and.right Px)))
+
+lemma binary_union (P : A → Prop) [decP : decidable_pred P] {S : finset A} :
+  S = {a ∈ S | P a} ∪ {a ∈ S | ¬(P a)} :=
+ext take a, iff.intro
+  (suppose a ∈ S, decidable.by_cases
+    (suppose P a, mem_union_l (mem_sep_of_mem `a ∈ S` this))
+    (suppose ¬ P a, mem_union_r (mem_sep_of_mem `a ∈ S` this)))
+  (suppose a ∈ sep P S ∪ {a ∈ S | ¬ P a}, or.elim (mem_or_mem_of_mem_union this)
+    (suppose a ∈ sep P S,      mem_of_mem_sep this)
+    (suppose a ∈ {a ∈ S | ¬ P a}, mem_of_mem_sep this))
+
+lemma binary_inter_empty {P : A → Prop} [decP : decidable_pred P] {S : finset A} :
+  {a ∈ S | P a} ∩ {a ∈ S | ¬(P a)} = ∅ :=
+inter_eq_empty (take a, assume Pa nPa, absurd (of_mem_sep Pa) (of_mem_sep nPa))
+
+definition disjoint_sets (S : finset (finset A)) : Prop :=
+  ∀ s₁ s₂ (P₁ : s₁ ∈ S) (P₂ : s₂ ∈ S), s₁ ≠ s₂ → s₁ ∩ s₂ = ∅
+
+lemma disjoint_sets_sep_of_disjoint_sets {P : finset A → Prop} [decP : decidable_pred P] {S : finset (finset A)} :
+  disjoint_sets S → disjoint_sets {s ∈ S | P s} :=
+assume Pds, take s₁ s₂, assume P₁ P₂, Pds s₁ s₂ (mem_of_mem_sep P₁) (mem_of_mem_sep P₂)
+
+lemma binary_inter_empty_Union_disjoint_sets {P : finset A → Prop} [decP : decidable_pred P] {S : finset (finset A)} :
+  disjoint_sets S → Union {s ∈ S | P s} id ∩ Union {s ∈ S | ¬P s} id = ∅ :=
+assume Pds, inter_eq_empty (take a, assume Pa nPa,
+  obtain s Psin Pains, from iff.elim_left !mem_Union_iff Pa,
+  obtain t Ptin Paint, from iff.elim_left !mem_Union_iff nPa,
+  have s ≠ t,
+    from assume Peq, absurd (Peq ▸ of_mem_sep Psin) (of_mem_sep Ptin),
+  have e₁ : s ∩ t = empty, from Pds s t (mem_of_mem_sep Psin) (mem_of_mem_sep Ptin) `s ≠ t`,
+  have a ∈ s ∩ t,     from mem_inter Pains Paint,
+  have a ∈ empty,     from e₁ ▸ this,
+  absurd this !not_mem_empty)
+
+section
+variables {B: Type} [deceqB : decidable_eq B]
+include deceqB
+
+lemma binary_Union (f : A → finset B) {P : A → Prop} [decP : decidable_pred P] {s : finset A} :
+  Union s f = Union {a ∈ s | P a} f ∪ Union {a ∈ s | ¬P a} f :=
+begin rewrite [binary_union P at {1}], apply Union_union, exact binary_inter_empty end
+
+end
+
+open nat
+section
+
+variables {B : Type} [acmB : add_comm_monoid B]
+include acmB
+
+lemma Sum_binary_union (f : A → B) (P : A → Prop) [decP : decidable_pred P] {S : finset A} :
+  Sum S f = Sum {s ∈ S | P s} f + Sum {s ∈ S | ¬P s} f :=
+calc
+  Sum S f = Sum ({s ∈ S | P s} ∪ {s ∈ S | ¬(P s)}) f : binary_union
+      ... = Sum {s ∈ S | P s} f + Sum {s ∈ S | ¬P s} f : Sum_union f binary_inter_empty
+
+end
+
+lemma card_binary_Union_disjoint_sets (P : finset A → Prop) [decP : decidable_pred P] {S : finset (finset A)} :
+  disjoint_sets S → card (Union S id) = Sum {s ∈ S | P s} card + Sum {s ∈ S | ¬P s} card :=
+assume Pds, calc
+        card (Union S id)
+      = card (Union {s ∈ S | P s} id ∪ Union {s ∈ S | ¬P s} id) : binary_Union
+  ... = card (Union {s ∈ S | P s} id) + card (Union {s ∈ S | ¬P s} id) : card_union_of_disjoint (binary_inter_empty_Union_disjoint_sets Pds)
+  ... = Sum {s ∈ S | P s} card + Sum {s ∈ S | ¬P s} card : by rewrite [*(card_Union_of_disjoint _ id (disjoint_sets_sep_of_disjoint_sets Pds))]
+
+end partition
+end finset

old_library/data/finset/to_set.lean

@@ -0,0 +1,105 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+
+Interactions between finset and set.
+-/
+import data.finset.comb data.set.function
+open nat eq.ops set
+
+namespace finset
+
+variable {A : Type}
+variable [deceq : decidable_eq A]
+
+definition to_set (s : finset A) : set A := λx, x ∈ s
+abbreviation ts := @to_set A
+
+variables (s t : finset A) (x y : A)
+
+theorem mem_eq_mem_to_set : x ∈ s = (x ∈ ts s) := rfl
+
+definition to_set.inj {s₁ s₂ : finset A} : to_set s₁ = to_set s₂ → s₁ = s₂ :=
+λ h, ext (λ a, iff.of_eq (calc
+  (a ∈ s₁) = (a ∈ ts s₁) : mem_eq_mem_to_set
+       ... = (a ∈ ts s₂) : h
+       ... = (a ∈ s₂)    : mem_eq_mem_to_set))
+
+/- operations -/
+
+theorem mem_to_set_empty : (x ∈ ts ∅) = (x ∈ ∅) := rfl
+theorem to_set_empty : ts ∅ = (@set.empty A) := rfl
+
+theorem mem_to_set_univ [h : fintype A] : (x ∈ ts univ) = (x ∈ set.univ) :=
+  propext (iff.intro (assume H, trivial) (assume H, !mem_univ))
+theorem to_set_univ [h : fintype A] : ts univ = (set.univ : set A) := funext (λ x, !mem_to_set_univ)
+
+theorem mem_to_set_upto (x n : ℕ) : x ∈ ts (upto n) = (x ∈ {a | a < n}) := !mem_upto_eq
+theorem to_set_upto (n : ℕ) : ts (upto n) = {a | a < n} := funext (λ x, !mem_to_set_upto)
+
+include deceq
+
+theorem mem_to_set_insert : x ∈ insert y s = (x ∈ set.insert y s) := !mem_insert_eq
+theorem to_set_insert : insert y s = set.insert y s := funext (λ x, !mem_to_set_insert)
+
+theorem mem_to_set_union : x ∈ s ∪ t = (x ∈ ts s ∪ ts t) := !mem_union_eq
+theorem to_set_union : ts (s ∪ t) = ts s ∪ ts t := funext (λ x, !mem_to_set_union)
+
+theorem mem_to_set_inter : x ∈ s ∩ t = (x ∈ ts s ∩ ts t) := !mem_inter_eq
+theorem to_set_inter : ts (s ∩ t) = ts s ∩ ts t := funext (λ x, !mem_to_set_inter)
+
+theorem mem_to_set_diff : x ∈ s \ t = (x ∈ ts s \ ts t) := !mem_diff_eq
+theorem to_set_diff : ts (s \ t) = ts s \ ts t := funext (λ x, !mem_to_set_diff)
+
+theorem mem_to_set_sep (p : A → Prop) [h : decidable_pred p] : x ∈ sep p s = (x ∈ set.sep p s) :=
+  !finset.mem_sep_eq
+theorem to_set_sep (p : A → Prop) [h : decidable_pred p] : sep p s = set.sep p s :=
+  funext (λ x, !mem_to_set_sep)
+
+theorem mem_to_set_image {B : Type} [h : decidable_eq B] (f : A → B) {s : finset A} {y : B} :
+  y ∈ image f s = (y ∈ set.image f s) := !mem_image_eq
+theorem to_set_image {B : Type} [h : decidable_eq B] (f : A → B) (s : finset A) :
+  image f s = set.image f s := funext (λ x, !mem_to_set_image)
+
+/- relations -/
+
+attribute [instance]
+definition decidable_mem_to_set (x : A) (s : finset A) : decidable (x ∈ ts s) :=
+decidable_of_decidable_of_eq _ !mem_eq_mem_to_set
+
+theorem eq_of_to_set_eq_to_set {s t : finset A} (H : to_set s = to_set t) : s = t :=
+ext (take x, by rewrite [mem_eq_mem_to_set s, H])
+
+theorem eq_eq_to_set_eq : (s = t) = (ts s = ts t) :=
+propext (iff.intro (assume H, H ▸ rfl) !eq_of_to_set_eq_to_set)
+
+attribute [instance]
+definition decidable_to_set_eq (s t : finset A) : decidable (ts s = ts t) :=
+decidable_of_decidable_of_eq _ !eq_eq_to_set_eq
+
+theorem subset_eq_to_set_subset (s t : finset A) : (s ⊆ t) = (ts s ⊆ ts t) :=
+propext (iff.intro
+  (assume H, take x xs, mem_of_subset_of_mem H xs)
+  (assume H, subset_of_forall H))
+
+definition decidable_to_set_subset (s t : finset A) : decidable (ts s ⊆ ts t) :=
+decidable_of_decidable_of_eq _ !subset_eq_to_set_subset
+
+/- bounded quantifiers -/
+
+definition decidable_bounded_forall (s : finset A) (p : A → Prop) [h : decidable_pred p] :
+  decidable (∀₀ x ∈ ts s, p x) :=
+decidable_of_decidable_of_iff _ !all_iff_forall
+
+definition decidable_bounded_exists (s : finset A) (p : A → Prop) [h : decidable_pred p] :
+  decidable (∃₀ x ∈ ts s, p x) :=
+decidable_of_decidable_of_iff _ !any_iff_exists
+
+/- properties -/
+
+theorem inj_on_to_set {B : Type} [h : decidable_eq B] (f : A → B) (s : finset A) :
+  inj_on f s = inj_on f (ts s) :=
+rfl
+
+end finset

old_library/data/fintype/basic.lean

@@ -0,0 +1,225 @@
+/-
+Copyright (c) 2015 Leonardo de Moura. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+
+Finite type (type class).
+-/
+import data.list.perm data.list.as_type data.bool data.equiv
+open list bool unit decidable option function
+
+structure fintype [class] (A : Type) : Type :=
+(elems : list A) (unique : nodup elems) (complete : ∀ a, a ∈ elems)
+
+definition elements_of (A : Type) [h : fintype A] : list A :=
+@fintype.elems A h
+
+section
+open equiv
+definition fintype_of_equiv {A B : Type} [h : fintype A] : A ≃ B → fintype B
+| (mk f g l r) :=
+  fintype.mk
+    (map f (elements_of A))
+    (nodup_map (injective_of_left_inverse l) !fintype.unique)
+    (λ b,
+      have g b ∈ elements_of A, from fintype.complete (g b),
+      have f (g b) ∈ map f (elements_of A), from mem_map f this,
+      by rewrite r at this; exact this)
+end
+
+attribute [instance]
+definition fintype_unit : fintype unit :=
+fintype.mk [star] dec_trivial (λ u, match u with star := dec_trivial end)
+
+attribute [instance]
+definition fintype_bool : fintype bool :=
+fintype.mk [ff, tt]
+  dec_trivial
+  (λ b, match b with | tt := dec_trivial | ff := dec_trivial end)
+
+attribute [instance]
+definition fintype_product {A B : Type} : Π [h₁ : fintype A] [h₂ : fintype B], fintype (A × B)
+| (fintype.mk e₁ u₁ c₁) (fintype.mk e₂ u₂ c₂) :=
+  fintype.mk
+    (product e₁ e₂)
+    (nodup_product u₁ u₂)
+    (λ p,
+      match p with
+      (a, b) := mem_product (c₁ a) (c₂ b)
+      end)
+
+/- auxiliary function for finding 'a' s.t. f a ≠ g a -/
+section find_discr
+variables {A B : Type}
+variable  [h : decidable_eq B]
+include h
+definition find_discr (f g : A → B) : list A → option A
+| []     := none
+| (a::l) := if f a = g a then find_discr l else some a
+
+theorem find_discr_nil (f g : A → B) : find_discr f g [] = none :=
+rfl
+
+theorem find_discr_cons_of_ne {f g : A → B} {a : A} (l : list A) : f a ≠ g a → find_discr f g (a::l) = some a :=
+assume ne, if_neg ne
+
+theorem find_discr_cons_of_eq {f g : A → B} {a : A} (l : list A) : f a = g a → find_discr f g (a::l) = find_discr f g l :=
+assume eq, if_pos eq
+
+theorem ne_of_find_discr_eq_some {f g : A → B} {a : A} : ∀ {l}, find_discr f g l = some a → f a ≠ g a
+| []     e := by contradiction
+| (x::l) e := by_cases
+  (suppose f x = g x,
+     have find_discr f g l = some a, by rewrite [find_discr_cons_of_eq l this at e]; exact e,
+     ne_of_find_discr_eq_some this)
+  (assume h : f x ≠ g x,
+     have some x = some a, by rewrite [find_discr_cons_of_ne l h at e]; exact e,
+     by clear ne_of_find_discr_eq_some; injection this; subst a; exact h)
+
+theorem all_eq_of_find_discr_eq_none {f g : A → B} : ∀ {l}, find_discr f g l = none → ∀ a, a ∈ l → f a = g a
+| []     e a i := absurd i !not_mem_nil
+| (x::l) e a i := by_cases
+  (assume fx_eq_gx : f x = g x,
+    or.elim (eq_or_mem_of_mem_cons i)
+      (suppose a = x, by rewrite [-this at fx_eq_gx]; exact fx_eq_gx)
+      (suppose a ∈ l,
+        have aux : find_discr f g l = none, by rewrite [find_discr_cons_of_eq l fx_eq_gx at e]; exact e,
+        all_eq_of_find_discr_eq_none aux a this))
+  (suppose f x ≠ g x,
+    by rewrite [find_discr_cons_of_ne l this at e]; contradiction)
+end find_discr
+
+attribute [instance]
+definition decidable_eq_fun {A B : Type} [h₁ : fintype A] [h₂ : decidable_eq B] : decidable_eq (A → B) :=
+λ f g,
+  match h₁ with
+  | fintype.mk e u c :=
+    match find_discr f g e with
+    | some a := λ h : find_discr f g e = some a, inr (λ f_eq_g : f = g, absurd (by rewrite f_eq_g; reflexivity) (ne_of_find_discr_eq_some h))
+    | none   := λ h : find_discr f g e = none, inl (show f = g, from funext (λ a : A, all_eq_of_find_discr_eq_none h a (c a)))
+    end rfl
+  end
+
+section check_pred
+variables {A : Type}
+
+definition check_pred (p : A → Prop) [h : decidable_pred p] : list A → bool
+| []     := tt
+| (a::l) := if p a then check_pred l else ff
+
+theorem check_pred_cons_of_pos {p : A → Prop} [h : decidable_pred p] {a : A} (l : list A) : p a → check_pred p (a::l) = check_pred p l :=
+assume pa, if_pos pa
+
+theorem check_pred_cons_of_neg {p : A → Prop} [h : decidable_pred p] {a : A} (l : list A) : ¬ p a → check_pred p (a::l) = ff :=
+assume npa, if_neg npa
+
+theorem all_of_check_pred_eq_tt {p : A → Prop} [h : decidable_pred p] : ∀ {l : list A}, check_pred p l = tt → ∀ {a}, a ∈ l → p a
+| []     eqtt a ainl := absurd ainl !not_mem_nil
+| (b::l) eqtt a ainbl := by_cases
+  (suppose p b, or.elim (eq_or_mem_of_mem_cons ainbl)
+    (suppose a = b, by rewrite [this]; exact `p b`)
+    (suppose a ∈ l,
+      have check_pred p l = tt, by rewrite [check_pred_cons_of_pos _ `p b` at eqtt]; exact eqtt,
+      all_of_check_pred_eq_tt this `a ∈ l`))
+  (suppose ¬ p b,
+    by rewrite [check_pred_cons_of_neg _ this at eqtt]; exact (bool.no_confusion eqtt))
+
+theorem ex_of_check_pred_eq_ff {p : A → Prop} [h : decidable_pred p] : ∀ {l : list A}, check_pred p l = ff → ∃ w, ¬ p w
+| []     eqtt := bool.no_confusion eqtt
+| (a::l) eqtt := by_cases
+  (suppose p a,
+    have check_pred p l = ff, by rewrite [check_pred_cons_of_pos _ this at eqtt]; exact eqtt,
+    ex_of_check_pred_eq_ff this)
+  (suppose ¬ p a, exists.intro a this)
+end check_pred
+
+attribute [instance]
+definition decidable_forall_finite {A : Type} {p : A → Prop} [h₁ : fintype A] [h₂ : decidable_pred p]
+           : decidable (∀ x : A, p x) :=
+match h₁ with
+| fintype.mk e u c :=
+  match check_pred p e with
+  | tt := suppose check_pred p e = tt, inl (take a : A, all_of_check_pred_eq_tt this (c a))
+  | ff := suppose check_pred p e = ff,
+    inr (suppose ∀ x, p x,
+         obtain (a : A) (w : ¬ p a), from ex_of_check_pred_eq_ff `check_pred p e = ff`,
+         absurd (this a) w)
+  end rfl
+end
+
+attribute [instance]
+definition decidable_exists_finite {A : Type} {p : A → Prop} [h₁ : fintype A] [h₂ : decidable_pred p]
+           : decidable (∃ x : A, p x) :=
+match h₁ with
+| fintype.mk e u c :=
+  match check_pred (λ a, ¬ p a) e with
+  | tt := λ h : check_pred (λ a, ¬ p a) e = tt, inr (λ ex : (∃ x, p x),
+          obtain x px, from ex,
+          absurd px (all_of_check_pred_eq_tt h (c x)))
+  | ff := λ h : check_pred (λ a, ¬ p a) e = ff, inl (
+          have ∃ x, ¬¬p x, from ex_of_check_pred_eq_ff h,
+          obtain x nnpx, from this, exists.intro x (not_not_elim nnpx))
+  end rfl
+end
+
+open list.as_type
+-- Auxiliary function for returning a list with all elements of the type: (list.as_type l)
+-- Remark ⟪s⟫ is notation for (list.as_type l)
+-- We use this function to define the instance for (fintype ⟪s⟫)
+private definition ltype_elems {A : Type} {s : list A} : Π {l : list A}, l ⊆ s → list ⟪s⟫
+| []     h := []
+| (a::l) h := lval a (h a !mem_cons) :: ltype_elems (sub_of_cons_sub h)
+
+private theorem mem_of_mem_ltype_elems {A : Type} {a : A} {s : list A}
+                : Π {l : list A} {h : l ⊆ s} {m : a ∈ s}, mk a m ∈ ltype_elems h → a ∈ l
+| []     h m lin := absurd lin !not_mem_nil
+| (b::l) h m lin := or.elim (eq_or_mem_of_mem_cons lin)
+  (suppose mk a m = mk b (h b (mem_cons b l)),
+     as_type.no_confusion this (λ aeqb em, by rewrite [aeqb]; exact !mem_cons))
+  (suppose mk a m ∈ ltype_elems (sub_of_cons_sub h),
+     have a ∈ l, from mem_of_mem_ltype_elems this,
+     mem_cons_of_mem _ this)
+
+private theorem nodup_ltype_elems {A : Type} {s : list A} : Π {l : list A} (d : nodup l) (h : l ⊆ s), nodup (ltype_elems h)
+| []     d h := nodup_nil
+| (a::l) d h :=
+  have d₁    : nodup l, from nodup_of_nodup_cons d,
+  have nainl : a ∉ l, from not_mem_of_nodup_cons d,
+  let  h₁    : l ⊆ s := sub_of_cons_sub h in
+  have d₂    : nodup (ltype_elems h₁), from nodup_ltype_elems d₁ h₁,
+  have nin   : mk a (h a (mem_cons a l)) ∉ ltype_elems h₁, from
+    assume ab, absurd (mem_of_mem_ltype_elems ab) nainl,
+  nodup_cons nin d₂
+
+private theorem mem_ltype_elems {A : Type} {s : list A} {a : ⟪s⟫}
+                : Π {l : list A} (h : l ⊆ s), value a ∈ l → a ∈ ltype_elems h
+| []     h vainl  := absurd vainl !not_mem_nil
+| (b::l) h vainbl := or.elim (eq_or_mem_of_mem_cons vainbl)
+  (λ vaeqb : value a = b,
+   begin
+      revert vaeqb h,
+      -- TODO(Leo): check why 'cases a with va, ma' produces an incorrect proof
+      eapply as_type.cases_on a,
+      intro va ma vaeqb,
+      rewrite -vaeqb, intro h,
+      apply mem_cons
+   end)
+  (λ vainl : value a ∈ l,
+     have aux : a ∈ ltype_elems (sub_of_cons_sub h), from mem_ltype_elems (sub_of_cons_sub h) vainl,
+     mem_cons_of_mem _ aux)
+
+attribute [instance]
+definition fintype_list_as_type {A : Type} [h : decidable_eq A] {s : list A} : fintype ⟪s⟫ :=
+let  nds   : list A := erase_dup s in
+have sub₁  : nds ⊆ s,   from erase_dup_sub s,
+have sub₂  : s ⊆ nds,   from sub_erase_dup s,
+have dnds  : nodup nds, from nodup_erase_dup s,
+let  e     : list ⟪s⟫ := ltype_elems sub₁ in
+fintype.mk
+  e
+  (nodup_ltype_elems dnds sub₁)
+  (take a : ⟪s⟫,
+   show a ∈ e, from
+     have value a ∈ s,   from is_member a,
+     have value a ∈ nds, from sub₂ this,
+     mem_ltype_elems sub₁ this)

old_library/data/fintype/card.lean

@@ -0,0 +1,52 @@
+/-
+Copyright (c) 2015 Haitao Zhang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Haitao Zhang
+
+Cardinality for finite types.
+-/
+import .basic data.list data.finset.card
+open eq.ops nat function list finset
+
+namespace fintype
+
+attribute [reducible]
+definition card (A : Type) [finA : fintype A] := finset.card (@finset.univ A _)
+
+lemma card_eq_card_image_of_inj
+      {A : Type} [finA : fintype A] [deceqA : decidable_eq A]
+      {B : Type} [finB : fintype B] [deceqB : decidable_eq B]
+      {f : A → B} :
+  injective f → finset.card (image f univ) = card A :=
+assume Pinj,
+card_image_eq_of_inj_on (to_set_univ⁻¹ ▸ (iff.mp !set.injective_iff_inj_on_univ Pinj))
+
+-- General version of the pigeonhole principle. See also data.less_than.
+lemma card_le_of_inj (A : Type) [finA : fintype A] [deceqA : decidable_eq A]
+                     (B : Type) [finB : fintype B] [deceqB : decidable_eq B] :
+   (∃ f : A → B, injective f) → card A ≤ card B :=
+assume Pex, obtain f Pinj, from Pex,
+have Pinj_on_univ : _, from iff.mp !set.injective_iff_inj_on_univ Pinj,
+have Pinj_ts : set.inj_on f (ts univ), from to_set_univ⁻¹ ▸ Pinj_on_univ,
+have Psub : (image f univ) ⊆ univ,     from !subset_univ,
+finset.card_le_of_inj_on univ univ (exists.intro f (and.intro Pinj_ts Psub))
+
+-- used to prove that inj ∧ eq card => surj
+lemma univ_of_card_eq_univ {A : Type} [finA : fintype A] [deceqA : decidable_eq A] {s : finset A} :
+  finset.card s = card A → s = univ :=
+assume Pcardeq, ext (take a,
+have D : decidable (a ∈ s), from decidable_mem a s, begin
+apply iff.intro,
+  intro ain, apply mem_univ,
+  intro ain, cases D with Pin Pnin,
+    exact Pin,
+    have Pplus1 : finset.card (insert a s) = finset.card s + 1,
+      from card_insert_of_not_mem Pnin,
+    rewrite Pcardeq at Pplus1,
+    have Ple : finset.card (insert a s) ≤ card A,
+      begin apply card_le_card_of_subset, apply subset_univ end,
+    rewrite Pplus1 at Ple,
+    exact false.elim (not_succ_le_self Ple)
+end)
+
+end fintype

old_library/data/fintype/default.lean

@@ -0,0 +1,8 @@
+/-
+Copyright (c) 2015 Leonardo de Moura. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+
+Finite type (type class).
+-/
+import .basic .card

old_library/data/fintype/fintype.md

@@ -0,0 +1,8 @@
+data.fintype
+============
+
+Finite types.
+
+* [basic](basic.lean) 
+* [function](function.lean)
+* [card](card.lean)

old_library/data/fintype/function.lean

@@ -0,0 +1,455 @@
+/-
+Copyright (c) 2015 Haitao Zhang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+
+Author : Haitao Zhang
+-/
+import data
+
+open nat function eq.ops
+
+namespace list
+-- this is in preparation for counting the number of finite functions
+section list_of_lists
+open prod
+variable {A : Type}
+
+definition cons_pair (pr : A × list A) := (pr1 pr) :: (pr2 pr)
+
+definition cons_all_of (elts : list A) (ls : list (list A)) : list (list A) :=
+           map cons_pair (product elts ls)
+
+lemma pair_of_cons {a} {l} {pr : A × list A} : cons_pair pr = a::l → pr = (a, l) :=
+      prod.destruct pr (λ p1 p2, assume Peq, list.no_confusion Peq (by intros; substvars))
+
+lemma cons_pair_inj : injective (@cons_pair A) :=
+      take p1 p2, assume Pl,
+      prod.eq (list.no_confusion Pl (λ P1 P2, P1)) (list.no_confusion Pl (λ P1 P2, P2))
+
+lemma nodup_of_cons_all {elts : list A} {ls : list (list A)}
+      : nodup elts → nodup ls → nodup (cons_all_of elts ls) :=
+      assume Pelts Pls,
+      nodup_map cons_pair_inj (nodup_product Pelts Pls)
+
+lemma length_cons_all {elts : list A} {ls : list (list A)} :
+      length (cons_all_of elts ls) = length elts * length ls := calc
+      length (cons_all_of elts ls) = length (product elts ls) : length_map
+                               ... = length elts * length ls : length_product
+
+variable [finA : fintype A]
+include finA
+
+definition all_lists_of_len : ∀ (n : nat), list (list A)
+| 0        := [[]]
+| (succ n) := cons_all_of (elements_of A) (all_lists_of_len n)
+
+definition all_nodups_of_len [deceqA : decidable_eq A] (n : nat) : list (list A) :=
+           filter nodup (all_lists_of_len n)
+
+lemma nodup_all_lists : ∀ {n : nat}, nodup (@all_lists_of_len A _ n)
+| 0                   := nodup_singleton []
+| (succ n)            := nodup_of_cons_all (fintype.unique A) nodup_all_lists
+
+lemma nodup_all_nodups [deceqA : decidable_eq A] {n : nat} :
+      nodup (@all_nodups_of_len A _ _ n) :=
+      nodup_filter nodup nodup_all_lists
+
+lemma mem_all_lists : ∀ {n : nat} {l : list A}, length l = n → l ∈ all_lists_of_len n
+| 0 []              := assume P, mem_cons [] []
+| 0 (a::l)          := assume Peq, by contradiction
+| (succ n) []       := assume Peq, by contradiction
+| (succ n) (a::l)   := assume Peq, begin
+                    apply mem_map, apply mem_product,
+                      exact fintype.complete a,
+                      exact mem_all_lists (succ.inj Peq)
+                    end
+
+lemma mem_all_nodups [deceqA : decidable_eq A] (n : nat) (l : list A) :
+      length l = n → nodup l → l ∈ all_nodups_of_len n :=
+      assume Pl Pn, mem_filter_of_mem (mem_all_lists Pl) Pn
+
+lemma nodup_mem_all_nodups [deceqA : decidable_eq A] {n : nat} ⦃l : list A⦄ :
+      l ∈ all_nodups_of_len n → nodup l :=
+      assume Pl, of_mem_filter Pl
+
+lemma length_mem_all_lists : ∀ {n : nat} ⦃l : list A⦄,
+                           l ∈ all_lists_of_len n → length l = n
+| 0 []             := assume P, rfl
+| 0 (a::l)         := assume Pin, have Peq : (a::l) = [], from mem_singleton Pin,
+                   by contradiction
+| (succ n) []      := assume Pin, obtain pr Pprin Ppr, from exists_of_mem_map Pin,
+                   by contradiction
+| (succ n) (a::l)  := assume Pin, obtain pr Pprin Ppr, from exists_of_mem_map Pin,
+                   have Pl : l ∈ all_lists_of_len n,
+                     from mem_of_mem_product_right ((pair_of_cons Ppr) ▸ Pprin),
+                   by rewrite [length_cons, length_mem_all_lists Pl]
+
+lemma length_mem_all_nodups [deceqA : decidable_eq A] {n : nat} ⦃l : list A⦄ :
+      l ∈ all_nodups_of_len n → length l = n :=
+      assume Pl, length_mem_all_lists (mem_of_mem_filter Pl)
+
+open fintype
+lemma length_all_lists : ∀ {n : nat}, length (@all_lists_of_len A _ n) = (card A) ^ n
+| 0         := calc length [[]] = 1 : length_cons
+| (succ n)  := calc length _ = card A * length (all_lists_of_len n) : length_cons_all
+                         ... = card A * (card A ^ n) : length_all_lists
+                         ... = (card A ^ n) * card A : mul.comm
+                         ... = (card A) ^ (succ n) : pow_succ'
+
+
+end list_of_lists
+
+section kth
+
+variable {A : Type}
+
+definition kth : ∀ k (l : list A), k < length l → A
+| k []        := begin rewrite length_nil, intro Pltz, exact absurd Pltz !not_lt_zero end
+| 0 (a::l)    := λ P, a
+| (k+1) (a::l):= by rewrite length_cons; intro Plt; exact kth k l (lt_of_succ_lt_succ Plt)
+
+lemma kth_zero_of_cons {a} (l : list A) (P : 0 < length (a::l)) : kth 0 (a::l) P = a :=
+      rfl
+lemma kth_succ_of_cons {a} k (l : list A) (P : k+1 < length (a::l)) :
+      kth (succ k) (a::l) P = kth k l (lt_of_succ_lt_succ P) :=
+      rfl
+
+lemma kth_mem : ∀ {k : nat} {l : list A} P, kth k l P ∈ l
+| k []            := assume P, absurd P !not_lt_zero
+| 0 (a::l)        := assume P, by rewrite kth_zero_of_cons; apply mem_cons
+| (succ k) (a::l) := assume P, by
+                  rewrite [kth_succ_of_cons]; apply mem_cons_of_mem a; apply kth_mem
+
+-- Leo provided the following proof.
+lemma eq_of_kth_eq [deceqA : decidable_eq A]
+      : ∀ {l1 l2 : list A} (Pleq : length l1 = length l2),
+          (∀ (k : nat) (Plt1 : k < length l1) (Plt2 : k < length l2), kth k l1 Plt1 = kth k l2 Plt2) → l1 = l2
+| []       []       h₁ h₂ := rfl
+| (a₁::l₁) []       h₁ h₂ := by contradiction
+| []       (a₂::l₂) h₁ h₂ := by contradiction
+| (a₁::l₁) (a₂::l₂) h₁ h₂ :=
+  have ih₁ : length l₁ = length l₂, by injection h₁; eassumption,
+  have ih₂ : ∀ (k : nat) (plt₁ : k < length l₁) (plt₂ : k < length l₂), kth k l₁ plt₁ = kth k l₂ plt₂,
+    begin
+      intro k plt₁ plt₂,
+      have splt₁ : succ k < length l₁ + 1, from succ_le_succ plt₁,
+      have splt₂ : succ k < length l₂ + 1, from succ_le_succ plt₂,
+      have keq   : kth (succ k) (a₁::l₁) splt₁ = kth (succ k) (a₂::l₂) splt₂, from h₂ (succ k) splt₁ splt₂,
+      rewrite *kth_succ_of_cons at keq,
+      exact keq
+    end,
+  have ih  : l₁ = l₂, from eq_of_kth_eq ih₁ ih₂,
+  have k₁  : a₁ = a₂,
+    begin
+      have lt₁ : 0 < length (a₁::l₁), from !zero_lt_succ,
+      have lt₂ : 0 < length (a₂::l₂), from !zero_lt_succ,
+      have e₁  : kth 0 (a₁::l₁) lt₁ = kth 0 (a₂::l₂) lt₂, from h₂ 0 lt₁ lt₂,
+      rewrite *kth_zero_of_cons at e₁,
+      assumption
+    end,
+  by subst l₁; subst a₁
+
+lemma kth_of_map {B : Type} {f : A → B} :
+      ∀ {k : nat} {l : list A} Plt Pmlt, kth k (map f l) Pmlt = f (kth k l Plt)
+| k []            := assume P, absurd P !not_lt_zero
+| 0 (a::l)        := assume Plt, by
+                  rewrite [map_cons]; intro Pmlt; rewrite [kth_zero_of_cons]
+| (succ k) (a::l) := assume P, begin
+                  rewrite [map_cons], intro Pmlt, rewrite [*kth_succ_of_cons],
+                  apply kth_of_map
+                  end
+
+lemma kth_find [deceqA : decidable_eq A] :
+      ∀ {l : list A} {a} P, kth (find a l) l P = a
+| []            := take a, assume P, absurd P !not_lt_zero
+| (x::l)        := take a, begin
+                have Pd : decidable (a = x), begin apply deceqA end,
+                cases Pd with Pe Pne,
+                  rewrite [find_cons_of_eq l Pe], intro P, rewrite [kth_zero_of_cons, Pe],
+                  rewrite [find_cons_of_ne l Pne], intro P, rewrite [kth_succ_of_cons],
+                  apply kth_find
+                end
+
+lemma find_kth [deceqA : decidable_eq A] :
+      ∀ {k : nat} {l : list A} P, find (kth k l P) l < length l
+| k []            := assume P, absurd P !not_lt_zero
+| 0 (a::l)        := assume P, begin
+                  rewrite [kth_zero_of_cons, find_cons_of_eq l rfl, length_cons],
+                  exact !zero_lt_succ
+                  end
+| (succ k) (a::l) := assume P, begin
+                  rewrite [kth_succ_of_cons],
+                  have Pd : decidable ((kth k l (lt_of_succ_lt_succ P)) = a),
+                    begin apply deceqA end,
+                  cases Pd with Pe Pne,
+                    rewrite [find_cons_of_eq l Pe], apply zero_lt_succ,
+                    rewrite [find_cons_of_ne l Pne], apply succ_lt_succ, apply find_kth
+                  end
+
+lemma find_kth_of_nodup [deceqA : decidable_eq A] :
+      ∀ {k : nat} {l : list A} P, nodup l → find (kth k l P) l = k
+| k []            := assume P, absurd P !not_lt_zero
+| 0 (a::l)        := assume Plt Pnodup,
+                  by rewrite [kth_zero_of_cons, find_cons_of_eq l rfl]
+| (succ k) (a::l) := assume Plt Pnodup, begin
+                  rewrite [kth_succ_of_cons],
+                  have Pd : decidable ((kth k l (lt_of_succ_lt_succ Plt)) = a),
+                    begin apply deceqA end,
+                  cases Pd with Pe Pne,
+                    have Pin : a ∈ l, begin rewrite -Pe, apply kth_mem end,
+                    exact absurd Pin (not_mem_of_nodup_cons Pnodup),
+                    rewrite [find_cons_of_ne l Pne], apply congr (eq.refl succ),
+                    apply find_kth_of_nodup (lt_of_succ_lt_succ Plt) (nodup_of_nodup_cons Pnodup)
+                  end
+
+end kth
+
+end list
+
+
+namespace fintype
+open list
+
+section found
+
+variables {A B : Type}
+variable [finA : fintype A]
+include finA
+
+lemma find_in_range [deceqB : decidable_eq B] {f : A → B} (b : B) :
+    ∀ (l : list A) P, f (kth (find b (map f l)) l P) = b
+| []       := assume P, begin exact absurd P !not_lt_zero end
+| (a::l)   := decidable.rec_on (deceqB b (f a))
+              (assume Peq, begin
+              rewrite [map_cons f a l, find_cons_of_eq _ Peq],
+              intro P, rewrite [kth_zero_of_cons], exact (Peq⁻¹)
+              end)
+              (assume Pne, begin
+              rewrite [map_cons f a l, find_cons_of_ne _ Pne],
+              intro P,
+              rewrite [kth_succ_of_cons (find b (map f l)) l P],
+              exact find_in_range l (lt_of_succ_lt_succ P)
+              end)
+
+end found
+
+section list_to_fun
+variables {A B : Type}
+variable [finA : fintype A]
+include finA
+
+definition fun_to_list (f : A → B) : list B := map f (elems A)
+
+lemma length_map_of_fintype (f : A → B) : length (map f (elems A)) = card A :=
+      by apply length_map
+
+variable [deceqA : decidable_eq A]
+include deceqA
+
+lemma fintype_find (a : A) : find a (elems A) < card A :=
+      find_lt_length (complete a)
+
+definition list_to_fun (l : list B) (leq : length l = card A) : A → B :=
+           take x,
+           kth _ _ (leq⁻¹ ▸ fintype_find x)
+
+definition all_funs [finB : fintype B] : list (A → B) :=
+           dmap (λ l, length l = card A) list_to_fun (all_lists_of_len (card A))
+
+lemma list_to_fun_apply (l : list B) (leq : length l = card A) (a : A) :
+      ∀ P, list_to_fun l leq a = kth (find a (elems A)) l P :=
+      assume P, rfl
+
+variable [deceqB : decidable_eq B]
+include deceqB
+
+lemma fun_eq_list_to_fun_map (f : A → B) : ∀ P, f = list_to_fun (map f (elems A)) P :=
+      assume Pleq, funext (take a,
+      have Plt : _, from Pleq⁻¹ ▸ find_lt_length (complete a), begin
+      rewrite [list_to_fun_apply _ Pleq a (Pleq⁻¹ ▸ find_lt_length (complete a))],
+      have Pmlt : find a (elems A) < length (map f (elems A)),
+        begin rewrite length_map, exact Plt end,
+      rewrite [@kth_of_map A B f (find a (elems A)) (elems A) Plt _, kth_find]
+      end)
+
+lemma list_eq_map_list_to_fun  (l : list B) (leq : length l = card A)
+                    : l = map (list_to_fun l leq) (elems A) :=
+      begin
+      apply eq_of_kth_eq, rewrite length_map, apply leq,
+        intro k Plt Plt2,
+        have Plt1 : k < length (elems A), begin apply leq ▸ Plt end,
+        have Plt3 : find (kth k (elems A) Plt1) (elems A) < length l,
+           begin rewrite leq, apply find_kth end,
+        rewrite [kth_of_map Plt1 Plt2, list_to_fun_apply l leq _ Plt3],
+        congruence,
+        rewrite [find_kth_of_nodup Plt1 (unique A)]
+      end
+
+lemma fun_to_list_to_fun (f : A → B) : ∀ P, list_to_fun (fun_to_list f) P = f :=
+      assume P, (fun_eq_list_to_fun_map f P)⁻¹
+
+lemma list_to_fun_to_list (l : list B) (leq : length l = card A) :
+      fun_to_list (list_to_fun l leq) = l
+      := (list_eq_map_list_to_fun l leq)⁻¹
+
+lemma dinj_list_to_fun : dinj (λ (l : list B), length l = card A) list_to_fun :=
+      take l1 l2 Pl1 Pl2 Peq,
+      by rewrite [list_eq_map_list_to_fun l1 Pl1, list_eq_map_list_to_fun l2 Pl2, Peq]
+
+variable [finB : fintype B]
+include finB
+
+lemma nodup_all_funs : nodup (@all_funs A B _ _ _) :=
+      dmap_nodup_of_dinj dinj_list_to_fun nodup_all_lists
+
+lemma all_funs_complete (f : A → B) : f ∈ all_funs :=
+      have Plin : map f (elems A) ∈ all_lists_of_len (card A),
+        from mem_all_lists (by rewrite length_map),
+      have Plfin : list_to_fun (map f (elems A)) (length_map_of_fintype f) ∈ all_funs,
+        from mem_dmap _ Plin,
+      begin rewrite [fun_eq_list_to_fun_map f (length_map_of_fintype f)], apply Plfin end
+
+lemma all_funs_to_all_lists :
+      map fun_to_list (@all_funs A B _ _ _) = all_lists_of_len (card A) :=
+      map_dmap_of_inv_of_pos list_to_fun_to_list length_mem_all_lists
+
+lemma length_all_funs : length (@all_funs A B _ _ _) = (card B) ^ (card A) := calc
+      length _ = length (map fun_to_list all_funs) : length_map
+           ... = length (all_lists_of_len (card A)) : all_funs_to_all_lists
+           ... = (card B) ^ (card A) : length_all_lists
+
+attribute [instance]
+definition fun_is_fintype : fintype (A → B) :=
+           fintype.mk all_funs nodup_all_funs all_funs_complete
+
+lemma card_funs : card (A → B) = (card B) ^ (card A) := length_all_funs
+
+end list_to_fun
+
+section surj_inv
+variables {A B : Type}
+variable [finA : fintype A]
+include finA
+
+-- surj from fintype domain implies fintype range
+lemma mem_map_of_surj {f : A → B} (surj : surjective f) : ∀ b, b ∈ map f (elems A) :=
+      take b, obtain a Peq, from surj b,
+      Peq ▸ mem_map f (complete a)
+
+variable [deceqB : decidable_eq B]
+include deceqB
+
+lemma found_of_surj {f : A → B} (surj : surjective f) :
+      ∀ b, let elts := elems A, k := find b (map f elts) in k < length elts :=
+      λ b, let elts := elems A, img := map f elts, k := find b img in
+           have Pin : b ∈ img, from mem_map_of_surj surj b,
+           have Pfound : k < length img, from find_lt_length (mem_map_of_surj surj b),
+           length_map f elts ▸ Pfound
+
+definition right_inv {f : A → B} (surj : surjective f) : B → A :=
+           λ b, let elts := elems A, k := find b (map f elts) in
+           kth k elts (found_of_surj surj b)
+
+lemma right_inv_of_surj {f : A → B} (surj : surjective f) : f ∘ (right_inv surj) = id :=
+      funext (λ b, find_in_range b (elems A) (found_of_surj surj b))
+end surj_inv
+
+-- inj functions for equal card types are also surj and therefore bij
+-- the right inv (since it is surj) is also the left inv
+section inj
+open finset
+
+variables {A B : Type}
+variable [finA : fintype A]
+include finA
+variable [deceqA : decidable_eq A]
+include deceqA
+
+lemma inj_of_card_image_eq [deceqB : decidable_eq B] {f : A → B} :
+      finset.card (image f univ) = card A → injective f :=
+      assume Peq, by
+      rewrite [set.injective_iff_inj_on_univ, -to_set_univ];
+      apply inj_on_of_card_image_eq Peq
+
+variable [deceqB : decidable_eq B]
+include deceqB
+
+lemma nodup_of_inj {f : A → B} : injective f → nodup (map f (elems A)) :=
+      assume Pinj, nodup_map Pinj (unique A)
+
+lemma inj_of_nodup {f : A → B} :
+      nodup (map f (elems A)) → injective f :=
+      assume Pnodup, inj_of_card_image_eq (calc
+        finset.card (image f univ) = finset.card (to_finset (map f (elems A))) : rfl
+                               ... = finset.card (to_finset_of_nodup (map f (elems A)) Pnodup) : {(to_finset_eq_of_nodup Pnodup)⁻¹}
+                               ... = length (map f (elems A)) : rfl
+                               ... = length (elems A) : length_map
+                               ... = card A : rfl)
+
+
+variable [finB : fintype B]
+include finB
+
+lemma surj_of_inj_eq_card : card A = card B → ∀ {f : A → B}, injective f → surjective f :=
+assume Peqcard, take f, assume Pinj,
+decidable.rec_on decidable_forall_finite
+  (assume P : surjective f, P)
+  (assume Pnsurj : ¬surjective f,
+   obtain b Pne, from exists_not_of_not_forall Pnsurj,
+   have Pall : ∀ a, f a ≠ b, from forall_not_of_not_exists Pne,
+   have Pbnin : b ∉ image f univ, from λ Pin,
+   obtain a Pa, from exists_of_mem_image Pin, absurd (and.right Pa) (Pall a),
+   have Puniv : finset.card (image f univ) = card A, from card_eq_card_image_of_inj Pinj,
+   have Punivb : finset.card (image f univ) = card B, from eq.trans Puniv Peqcard,
+   have P : image f univ = univ, from univ_of_card_eq_univ Punivb,
+   absurd (P⁻¹▸ mem_univ b) Pbnin)
+
+end inj
+
+section perm
+
+definition all_injs (A : Type) [finA : fintype A] [deceqA : decidable_eq A] : list (A → A) :=
+           dmap (λ l, length l = card A) list_to_fun (all_nodups_of_len (card A))
+
+
+variable {A : Type}
+variable [finA : fintype A]
+include finA
+variable [deceqA : decidable_eq A]
+include deceqA
+
+lemma nodup_all_injs : nodup (all_injs A) :=
+      dmap_nodup_of_dinj dinj_list_to_fun nodup_all_nodups
+
+lemma all_injs_complete {f : A → A} : injective f → f ∈ (all_injs A) :=
+      assume Pinj,
+      have Plin : map f (elems A) ∈ all_nodups_of_len (card A),
+        from begin apply mem_all_nodups, apply length_map, apply nodup_of_inj Pinj end,
+      have Plfin : list_to_fun (map f (elems A)) (length_map_of_fintype f) ∈ !all_injs,
+        from mem_dmap _ Plin,
+      begin rewrite [fun_eq_list_to_fun_map f (length_map_of_fintype f)], apply Plfin end
+
+open finset
+
+lemma univ_of_leq_univ_of_nodup {l : list A} (n : nodup l) (leq : length l = card A) :
+      to_finset_of_nodup l n = univ :=
+       univ_of_card_eq_univ (calc
+        finset.card (to_finset_of_nodup l n) = length l : rfl
+                                         ... = card A : leq)
+
+lemma inj_of_mem_all_injs {f : A → A} : f ∈ (all_injs A) → injective f :=
+      assume Pfin, obtain l Pex, from exists_of_mem_dmap Pfin,
+      obtain leq Pin Peq, from Pex,
+      have Pmap : map f (elems A) = l, from Peq⁻¹ ▸ list_to_fun_to_list l leq,
+      begin apply inj_of_nodup, rewrite Pmap, apply nodup_mem_all_nodups Pin end
+
+lemma perm_of_inj {f : A → A} : injective f → perm (map f (elems A)) (elems A) :=
+      assume Pinj,
+      have P1 : univ = to_finset_of_nodup (elems A) (unique A), from rfl,
+      have P2 : to_finset_of_nodup (map f (elems A)) (nodup_of_inj Pinj) = univ,
+        from univ_of_leq_univ_of_nodup _ !length_map,
+      quot.exact (P1 ▸ P2)
+
+end perm
+
+end fintype

old_library/data/hf.lean

@@ -0,0 +1,614 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+
+Hereditarily finite sets: finite sets whose elements are all hereditarily finite sets.
+
+Remark: all definitions compute, however the performace is quite poor since
+we implement this module using a bijection from (finset nat) to nat, and
+this bijection is implemeted using the Ackermann coding.
+-/
+import data.nat data.finset.equiv data.list
+open nat binary
+open - [notation] finset
+
+definition hf := nat
+
+namespace hf
+local attribute hf [reducible]
+
+protected definition prio : num := num.succ std.priority.default
+
+attribute [instance]
+protected definition is_inhabited : inhabited hf :=
+nat.is_inhabited
+
+attribute [instance]
+protected definition has_decidable_eq : decidable_eq hf :=
+nat.has_decidable_eq
+
+definition of_finset (s : finset hf) : hf :=
+@equiv.to_fun _ _ finset_nat_equiv_nat s
+
+definition to_finset (h : hf) : finset hf :=
+@equiv.inv _ _ finset_nat_equiv_nat h
+
+definition to_nat (h : hf) : nat :=
+h
+
+definition of_nat (n : nat) : hf :=
+n
+
+lemma to_finset_of_finset (s : finset hf) : to_finset (of_finset s) = s :=
+@equiv.left_inv _ _ finset_nat_equiv_nat s
+
+lemma of_finset_to_finset (s : hf) : of_finset (to_finset s) = s :=
+@equiv.right_inv _ _ finset_nat_equiv_nat s
+
+lemma to_finset_inj {s₁ s₂ : hf} : to_finset s₁ = to_finset s₂ → s₁ = s₂ :=
+λ h, function.injective_of_left_inverse of_finset_to_finset h
+
+lemma of_finset_inj {s₁ s₂ : finset hf} : of_finset s₁ = of_finset s₂ → s₁ = s₂ :=
+λ h, function.injective_of_left_inverse to_finset_of_finset h
+
+/- empty -/
+definition empty : hf :=
+of_finset (finset.empty)
+
+notation `∅` := hf.empty
+
+/- insert -/
+definition insert (a s : hf) : hf :=
+of_finset (finset.insert a (to_finset s))
+
+/- mem -/
+definition mem (a : hf) (s : hf) : Prop :=
+finset.mem a (to_finset s)
+
+infix ∈ := mem
+notation [priority finset.prio] a ∉ b := ¬ mem a b
+
+lemma insert_lt_of_not_mem {a s : hf} : a ∉ s → s < insert a s :=
+begin
+  unfold [insert, of_finset, equiv.to_fun, finset_nat_equiv_nat, mem, to_finset, equiv.inv],
+  intro h,
+  rewrite [finset.to_nat_insert h],
+  rewrite [to_nat_of_nat, -zero_add s at {1}],
+  apply add_lt_add_right,
+  apply pow_pos_of_pos _ dec_trivial
+end
+
+lemma insert_lt_insert_of_not_mem_of_not_mem_of_lt {a s₁ s₂ : hf}
+      : a ∉ s₁ → a ∉ s₂ → s₁ < s₂ → insert a s₁ < insert a s₂ :=
+begin
+  unfold [insert, of_finset, equiv.to_fun, finset_nat_equiv_nat, mem, to_finset, equiv.inv],
+  intro h₁ h₂ h₃,
+  rewrite [finset.to_nat_insert h₁],
+  rewrite [finset.to_nat_insert h₂, *to_nat_of_nat],
+  apply add_lt_add_left h₃
+end
+
+open decidable
+attribute [instance]
+protected definition decidable_mem : ∀ a s, decidable (a ∈ s) :=
+λ a s, finset.decidable_mem a (to_finset s)
+
+lemma insert_le (a s : hf) : s ≤ insert a s :=
+by_cases
+  (suppose a ∈ s, by rewrite [↑insert, insert_eq_of_mem this, of_finset_to_finset])
+  (suppose a ∉ s, le_of_lt (insert_lt_of_not_mem this))
+
+lemma not_mem_empty (a : hf) : a ∉ ∅ :=
+begin unfold [mem, empty], rewrite to_finset_of_finset, apply finset.not_mem_empty end
+
+lemma mem_insert (a s : hf) : a ∈ insert a s :=
+begin unfold [mem, insert], rewrite to_finset_of_finset, apply finset.mem_insert end
+
+lemma mem_insert_of_mem {a s : hf} (b : hf) : a ∈ s → a ∈ insert b s :=
+begin unfold [mem, insert], intros, rewrite to_finset_of_finset, apply finset.mem_insert_of_mem, assumption end
+
+lemma eq_or_mem_of_mem_insert {a b s : hf} : a ∈ insert b s → a = b ∨ a ∈ s :=
+begin unfold [mem, insert], rewrite to_finset_of_finset, intros, apply eq_or_mem_of_mem_insert, assumption  end
+
+theorem mem_of_mem_insert_of_ne {x a : hf} {s : hf} : x ∈ insert a s → x ≠ a → x ∈ s :=
+begin unfold [mem, insert], rewrite to_finset_of_finset, intros, apply mem_of_mem_insert_of_ne, repeat assumption end
+
+protected theorem ext {s₁ s₂ : hf} : (∀ a, a ∈ s₁ ↔ a ∈ s₂) → s₁ = s₂ :=
+assume h,
+have to_finset s₁ = to_finset s₂, from finset.ext h,
+have of_finset (to_finset s₁) = of_finset (to_finset s₂), by rewrite this,
+by rewrite [*of_finset_to_finset at this]; exact this
+
+theorem insert_eq_of_mem {a : hf} {s : hf} : a ∈ s → insert a s = s :=
+begin unfold mem, intro h, unfold [mem, insert], rewrite (finset.insert_eq_of_mem h), rewrite of_finset_to_finset end
+
+attribute [recursor 4]
+protected theorem induction {P : hf → Prop}
+    (h₁ : P empty) (h₂ : ∀ (a s : hf), a ∉ s → P s → P (insert a s)) (s : hf) : P s :=
+have P (of_finset (to_finset s)), from
+  @finset.induction _ _ _ h₁
+    (λ a s nain ih,
+       begin
+         unfold [mem, insert] at h₂,
+         rewrite -(to_finset_of_finset s) at nain,
+         have P (insert a (of_finset s)), by exact h₂ a (of_finset s) nain ih,
+         rewrite [↑insert at this, to_finset_of_finset at this],
+         exact this
+       end)
+    (to_finset s),
+by rewrite of_finset_to_finset at this; exact this
+
+lemma insert_le_insert_of_le {a s₁ s₂ : hf} : a ∈ s₁ ∨ a ∉ s₂ → s₁ ≤ s₂ → insert a s₁ ≤ insert a s₂ :=
+suppose a ∈ s₁ ∨ a ∉ s₂,
+suppose s₁ ≤ s₂,
+by_cases
+  (suppose s₁ = s₂, by rewrite this)
+  (suppose s₁ ≠ s₂,
+    have s₁ < s₂, from lt_of_le_of_ne `s₁ ≤ s₂` `s₁ ≠ s₂`,
+    by_cases
+      (suppose a ∈ s₁, by_cases
+        (suppose a ∈ s₂, by rewrite [insert_eq_of_mem `a ∈ s₁`, insert_eq_of_mem `a ∈ s₂`]; assumption)
+        (suppose a ∉ s₂, by rewrite [insert_eq_of_mem `a ∈ s₁`]; exact le.trans `s₁ ≤ s₂` !insert_le))
+      (suppose a ∉ s₁, by_cases
+        (suppose a ∈ s₂, or.elim `a ∈ s₁ ∨ a ∉ s₂` (by contradiction) (by contradiction))
+        (suppose a ∉ s₂, le_of_lt (insert_lt_insert_of_not_mem_of_not_mem_of_lt `a ∉ s₁` `a ∉ s₂` `s₁ < s₂`))))
+
+/- union -/
+definition union (s₁ s₂ : hf) : hf :=
+of_finset (finset.union (to_finset s₁) (to_finset s₂))
+
+infix [priority hf.prio] ∪ := union
+
+theorem mem_union_left {a : hf} {s₁ : hf} (s₂ : hf) : a ∈ s₁ → a ∈ s₁ ∪ s₂ :=
+begin unfold mem, intro h, unfold union, rewrite to_finset_of_finset, apply finset.mem_union_left _ h end
+
+theorem mem_union_l {a : hf} {s₁ : hf} {s₂ : hf} : a ∈ s₁ → a ∈ s₁ ∪ s₂ :=
+mem_union_left s₂
+
+theorem mem_union_right {a : hf} {s₂ : hf} (s₁ : hf) : a ∈ s₂ → a ∈ s₁ ∪ s₂ :=
+begin unfold mem, intro h, unfold union, rewrite to_finset_of_finset, apply finset.mem_union_right _ h end
+
+theorem mem_union_r {a : hf} {s₂ : hf} {s₁ : hf} : a ∈ s₂ → a ∈ s₁ ∪ s₂ :=
+mem_union_right s₁
+
+theorem mem_or_mem_of_mem_union {a : hf} {s₁ s₂ : hf} : a ∈ s₁ ∪ s₂ → a ∈ s₁ ∨ a ∈ s₂ :=
+begin unfold [mem, union], rewrite to_finset_of_finset, intro h, apply finset.mem_or_mem_of_mem_union h end
+
+theorem mem_union_iff {a : hf} (s₁ s₂ : hf) : a ∈ s₁ ∪ s₂ ↔ a ∈ s₁ ∨ a ∈ s₂ :=
+iff.intro
+ (λ h, mem_or_mem_of_mem_union h)
+ (λ d, or.elim d
+   (λ i, mem_union_left _ i)
+   (λ i, mem_union_right _ i))
+
+theorem mem_union_eq {a : hf} (s₁ s₂ : hf) : (a ∈ s₁ ∪ s₂) = (a ∈ s₁ ∨ a ∈ s₂) :=
+propext !mem_union_iff
+
+theorem union_comm (s₁ s₂ : hf) : s₁ ∪ s₂ = s₂ ∪ s₁ :=
+hf.ext (λ a, by rewrite [*mem_union_eq]; exact or.comm)
+
+theorem union_assoc (s₁ s₂ s₃ : hf) : (s₁ ∪ s₂) ∪ s₃ = s₁ ∪ (s₂ ∪ s₃) :=
+hf.ext (λ a, by rewrite [*mem_union_eq]; exact or.assoc)
+
+theorem union_left_comm (s₁ s₂ s₃ : hf) : s₁ ∪ (s₂ ∪ s₃) = s₂ ∪ (s₁ ∪ s₃) :=
+!left_comm union_comm union_assoc s₁ s₂ s₃
+
+theorem union_right_comm (s₁ s₂ s₃ : hf) : (s₁ ∪ s₂) ∪ s₃ = (s₁ ∪ s₃) ∪ s₂ :=
+!right_comm union_comm union_assoc s₁ s₂ s₃
+
+theorem union_self (s : hf) : s ∪ s = s :=
+hf.ext (λ a, iff.intro
+  (λ ain, or.elim (mem_or_mem_of_mem_union ain) (λ i, i) (λ i, i))
+  (λ i, mem_union_left _ i))
+
+theorem union_empty (s : hf) : s ∪ ∅ = s :=
+hf.ext (λ a, iff.intro
+  (suppose a ∈ s ∪ ∅, or.elim (mem_or_mem_of_mem_union this) (λ i, i) (λ i, absurd i !not_mem_empty))
+  (suppose a ∈ s, mem_union_left _ this))
+
+theorem empty_union (s : hf) : ∅ ∪ s = s :=
+calc ∅ ∪ s = s ∪ ∅ : union_comm
+       ... = s     : union_empty
+
+/- inter -/
+definition inter (s₁ s₂ : hf) : hf :=
+of_finset (finset.inter (to_finset s₁) (to_finset s₂))
+
+infix [priority hf.prio] ∩ := inter
+
+theorem mem_of_mem_inter_left {a : hf} {s₁ s₂ : hf} : a ∈ s₁ ∩ s₂ → a ∈ s₁ :=
+begin unfold mem, unfold inter, rewrite to_finset_of_finset, intro h, apply finset.mem_of_mem_inter_left h end
+
+theorem mem_of_mem_inter_right {a : hf} {s₁ s₂ : hf} : a ∈ s₁ ∩ s₂ → a ∈ s₂ :=
+begin unfold mem, unfold inter, rewrite to_finset_of_finset, intro h, apply finset.mem_of_mem_inter_right h end
+
+theorem mem_inter {a : hf} {s₁ s₂ : hf} : a ∈ s₁ → a ∈ s₂ → a ∈ s₁ ∩ s₂ :=
+begin unfold mem, intro h₁ h₂, unfold inter, rewrite to_finset_of_finset, apply finset.mem_inter h₁ h₂ end
+
+theorem mem_inter_iff (a : hf) (s₁ s₂ : hf) : a ∈ s₁ ∩ s₂ ↔ a ∈ s₁ ∧ a ∈ s₂ :=
+iff.intro
+ (λ h, and.intro (mem_of_mem_inter_left h) (mem_of_mem_inter_right h))
+ (λ h, mem_inter (and.elim_left h) (and.elim_right h))
+
+theorem mem_inter_eq (a : hf) (s₁ s₂ : hf) : (a ∈ s₁ ∩ s₂) = (a ∈ s₁ ∧ a ∈ s₂) :=
+propext !mem_inter_iff
+
+theorem inter_comm (s₁ s₂ : hf) : s₁ ∩ s₂ = s₂ ∩ s₁ :=
+hf.ext (λ a, by rewrite [*mem_inter_eq]; exact and.comm)
+
+theorem inter_assoc (s₁ s₂ s₃ : hf) : (s₁ ∩ s₂) ∩ s₃ = s₁ ∩ (s₂ ∩ s₃) :=
+hf.ext (λ a, by rewrite [*mem_inter_eq]; exact and.assoc)
+
+theorem inter_left_comm (s₁ s₂ s₃ : hf) : s₁ ∩ (s₂ ∩ s₃) = s₂ ∩ (s₁ ∩ s₃) :=
+!left_comm inter_comm inter_assoc s₁ s₂ s₃
+
+theorem inter_right_comm (s₁ s₂ s₃ : hf) : (s₁ ∩ s₂) ∩ s₃ = (s₁ ∩ s₃) ∩ s₂ :=
+!right_comm inter_comm inter_assoc s₁ s₂ s₃
+
+theorem inter_self (s : hf) : s ∩ s = s :=
+hf.ext (λ a, iff.intro
+  (λ h, mem_of_mem_inter_right h)
+  (λ h, mem_inter h h))
+
+theorem inter_empty (s : hf) : s ∩ ∅ = ∅ :=
+hf.ext (λ a, iff.intro
+  (suppose a ∈ s ∩ ∅, absurd (mem_of_mem_inter_right this) !not_mem_empty)
+  (suppose a ∈ ∅,     absurd this !not_mem_empty))
+
+theorem empty_inter (s : hf) : ∅ ∩ s = ∅ :=
+calc ∅ ∩ s = s ∩ ∅ : inter_comm
+       ... = ∅     : inter_empty
+
+/- card -/
+definition card (s : hf) : nat :=
+finset.card (to_finset s)
+
+theorem card_empty : card ∅ = 0 :=
+rfl
+
+lemma ne_empty_of_card_eq_succ {s : hf} {n : nat} : card s = succ n → s ≠ ∅ :=
+by intros; substvars; contradiction
+
+/- erase -/
+definition erase (a : hf) (s : hf) : hf :=
+of_finset (erase a (to_finset s))
+
+theorem not_mem_erase (a : hf) (s : hf) : a ∉ erase a s :=
+begin unfold [mem, erase], rewrite to_finset_of_finset, apply finset.not_mem_erase end
+
+theorem card_erase_of_mem {a : hf} {s : hf} : a ∈ s → card (erase a s) = pred (card s) :=
+begin unfold mem, intro h, unfold [erase, card], rewrite to_finset_of_finset, apply finset.card_erase_of_mem h end
+
+theorem card_erase_of_not_mem {a : hf} {s : hf} : a ∉ s → card (erase a s) = card s :=
+begin unfold [mem], intro h, unfold [erase, card], rewrite to_finset_of_finset, apply finset.card_erase_of_not_mem h end
+
+theorem erase_empty (a : hf) : erase a ∅ = ∅ :=
+rfl
+
+theorem ne_of_mem_erase {a b : hf} {s : hf} : b ∈ erase a s → b ≠ a :=
+by intro h beqa; subst b; exact absurd h !not_mem_erase
+
+theorem mem_of_mem_erase {a b : hf} {s : hf} : b ∈ erase a s → b ∈ s :=
+begin unfold [erase, mem], rewrite to_finset_of_finset, intro h, apply mem_of_mem_erase h end
+
+theorem mem_erase_of_ne_of_mem {a b : hf} {s : hf} : a ≠ b → a ∈ s → a ∈ erase b s :=
+begin intro h₁, unfold mem, intro h₂, unfold erase, rewrite to_finset_of_finset, apply mem_erase_of_ne_of_mem h₁ h₂ end
+
+theorem mem_erase_iff (a b : hf) (s : hf) : a ∈ erase b s ↔ a ∈ s ∧ a ≠ b :=
+iff.intro
+  (assume H, and.intro (mem_of_mem_erase H) (ne_of_mem_erase H))
+  (assume H, mem_erase_of_ne_of_mem (and.right H) (and.left H))
+
+theorem mem_erase_eq (a b : hf) (s : hf) : a ∈ erase b s = (a ∈ s ∧ a ≠ b) :=
+propext !mem_erase_iff
+
+theorem erase_insert {a : hf} {s : hf} : a ∉ s → erase a (insert a s) = s :=
+begin
+  unfold [mem, erase, insert],
+  intro h, rewrite [to_finset_of_finset, finset.erase_insert h, of_finset_to_finset]
+end
+
+theorem insert_erase {a : hf} {s : hf} : a ∈ s → insert a (erase a s) = s :=
+begin
+  unfold mem, intro h, unfold [insert, erase],
+  rewrite [to_finset_of_finset, finset.insert_erase h, of_finset_to_finset]
+end
+
+
+/- subset -/
+definition subset (s₁ s₂ : hf) : Prop :=
+finset.subset (to_finset s₁) (to_finset s₂)
+
+infix [priority hf.prio] ⊆ := subset
+
+theorem empty_subset (s : hf) : ∅ ⊆ s :=
+begin unfold [empty, subset], rewrite to_finset_of_finset, apply finset.empty_subset (to_finset s) end
+
+theorem subset.refl (s : hf) : s ⊆ s :=
+begin unfold [subset], apply finset.subset.refl (to_finset s) end
+
+theorem subset.trans {s₁ s₂ s₃ : hf} : s₁ ⊆ s₂ → s₂ ⊆ s₃ → s₁ ⊆ s₃ :=
+begin unfold [subset], intro h₁ h₂, apply finset.subset.trans h₁ h₂ end
+
+theorem mem_of_subset_of_mem {s₁ s₂ : hf} {a : hf} : s₁ ⊆ s₂ → a ∈ s₁ → a ∈ s₂ :=
+begin unfold [subset, mem], intro h₁ h₂, apply finset.mem_of_subset_of_mem h₁ h₂ end
+
+theorem subset.antisymm {s₁ s₂ : hf} : s₁ ⊆ s₂ → s₂ ⊆ s₁ → s₁ = s₂ :=
+begin unfold [subset], intro h₁ h₂, apply to_finset_inj (finset.subset.antisymm h₁ h₂) end
+
+-- alternative name
+theorem eq_of_subset_of_subset {s₁ s₂ : hf} (H₁ : s₁ ⊆ s₂) (H₂ : s₂ ⊆ s₁) : s₁ = s₂ :=
+subset.antisymm H₁ H₂
+
+theorem subset_of_forall {s₁ s₂ : hf} : (∀x, x ∈ s₁ → x ∈ s₂) → s₁ ⊆ s₂ :=
+begin unfold [mem, subset], intro h, apply finset.subset_of_forall h end
+
+theorem subset_insert (s : hf) (a : hf) : s ⊆ insert a s :=
+begin unfold [subset, insert], rewrite to_finset_of_finset, apply finset.subset_insert (to_finset s) end
+
+theorem eq_empty_of_subset_empty {x : hf} (H : x ⊆ ∅) : x = ∅ :=
+subset.antisymm H (empty_subset x)
+
+theorem subset_empty_iff (x : hf) : x ⊆ ∅ ↔ x = ∅ :=
+iff.intro eq_empty_of_subset_empty (take xeq, by rewrite xeq; apply subset.refl ∅)
+
+theorem erase_subset_erase (a : hf) {s t : hf} : s ⊆ t → erase a s ⊆ erase a t :=
+begin unfold [subset, erase], intro h, rewrite *to_finset_of_finset, apply finset.erase_subset_erase a h end
+
+theorem erase_subset  (a : hf) (s : hf) : erase a s ⊆ s :=
+begin unfold [subset, erase], rewrite to_finset_of_finset, apply finset.erase_subset a (to_finset s) end
+
+theorem erase_eq_of_not_mem {a : hf} {s : hf} : a ∉ s → erase a s = s :=
+begin unfold [mem, erase], intro h, rewrite [finset.erase_eq_of_not_mem h, of_finset_to_finset] end
+
+theorem erase_insert_subset (a : hf) (s : hf) : erase a (insert a s) ⊆ s :=
+begin unfold [erase, insert, subset], rewrite [*to_finset_of_finset], apply finset.erase_insert_subset a (to_finset s) end
+
+theorem erase_subset_of_subset_insert {a : hf} {s t : hf} (H : s ⊆ insert a t) : erase a s ⊆ t :=
+hf.subset.trans (!hf.erase_subset_erase H) (erase_insert_subset a t)
+
+theorem insert_erase_subset (a : hf) (s : hf) : s ⊆ insert a (erase a s) :=
+decidable.by_cases
+  (assume ains : a ∈ s, by rewrite [!insert_erase ains]; apply subset.refl)
+  (assume nains : a ∉ s,
+    suffices s ⊆ insert a s, by rewrite [erase_eq_of_not_mem nains]; assumption,
+    subset_insert s a)
+
+theorem insert_subset_insert (a : hf) {s t : hf} : s ⊆ t → insert a s ⊆ insert a t :=
+begin
+  unfold [subset, insert], intro h,
+  rewrite *to_finset_of_finset, apply finset.insert_subset_insert a h
+end
+
+theorem subset_insert_of_erase_subset {s t : hf} {a : hf} (H : erase a s ⊆ t) : s ⊆ insert a t :=
+subset.trans (insert_erase_subset a s) (!insert_subset_insert H)
+
+theorem subset_insert_iff (s t : hf) (a : hf) : s ⊆ insert a t ↔ erase a s ⊆ t :=
+iff.intro !erase_subset_of_subset_insert !subset_insert_of_erase_subset
+
+theorem le_of_subset {s₁ s₂ : hf} : s₁ ⊆ s₂ → s₁ ≤ s₂ :=
+begin
+  revert s₂, induction s₁ with a s₁ nain ih,
+   take s₂, suppose ∅ ⊆ s₂, !zero_le,
+   take s₂, suppose insert a s₁ ⊆ s₂,
+     have a ∈ s₂,          from mem_of_subset_of_mem this !mem_insert,
+     have a ∉ erase a s₂,  from !not_mem_erase,
+     have s₁ ⊆ erase a s₂, from subset_of_forall
+       (take x xin, by_cases
+         (suppose x = a, by subst x; contradiction)
+         (suppose x ≠ a,
+           have x ∈ s₂, from mem_of_subset_of_mem `insert a s₁ ⊆ s₂` (mem_insert_of_mem _ `x ∈ s₁`),
+           mem_erase_of_ne_of_mem `x ≠ a` `x ∈ s₂`)),
+     have s₁ ≤ erase a s₂, from ih _ this,
+     have insert a s₁ ≤ insert a (erase a s₂), from
+       insert_le_insert_of_le (or.inr `a ∉ erase a s₂`) this,
+     by rewrite [insert_erase `a ∈ s₂` at this]; exact this
+end
+
+/- image -/
+definition image (f : hf → hf) (s : hf) : hf :=
+of_finset (finset.image f (to_finset s))
+
+theorem image_empty (f : hf → hf) : image f ∅ = ∅ :=
+rfl
+
+theorem mem_image_of_mem (f : hf → hf) {s : hf} {a : hf} : a ∈ s → f a ∈ image f s :=
+begin unfold [mem, image], intro h, rewrite to_finset_of_finset, apply finset.mem_image_of_mem f h end
+
+theorem mem_image {f : hf → hf} {s : hf} {a : hf} {b : hf} (H1 : a ∈ s) (H2 : f a = b) : b ∈ image f s :=
+eq.subst H2 (mem_image_of_mem f H1)
+
+theorem exists_of_mem_image {f : hf → hf} {s : hf} {b : hf} : b ∈ image f s → ∃a, a ∈ s ∧ f a = b :=
+begin unfold [mem, image], rewrite to_finset_of_finset, intro h, apply finset.exists_of_mem_image h end
+
+theorem mem_image_iff (f : hf → hf) {s : hf} {y : hf} : y ∈ image f s ↔ ∃x, x ∈ s ∧ f x = y :=
+begin unfold [mem, image], rewrite to_finset_of_finset, apply finset.mem_image_iff end
+
+theorem mem_image_eq (f : hf → hf) {s : hf} {y : hf} : y ∈ image f s = ∃x, x ∈ s ∧ f x = y :=
+propext (mem_image_iff f)
+
+theorem mem_image_of_mem_image_of_subset {f : hf → hf} {s t : hf} {y : hf} (H1 : y ∈ image f s) (H2 : s ⊆ t) : y ∈ image f t :=
+obtain x `x ∈ s` `f x = y`, from exists_of_mem_image H1,
+have x ∈ t, from mem_of_subset_of_mem H2 `x ∈ s`,
+show y ∈ image f t, from mem_image `x ∈ t` `f x = y`
+
+theorem image_insert (f : hf → hf) (s : hf) (a : hf) : image f (insert a s) = insert (f a) (image f s) :=
+begin unfold [image, insert], rewrite [*to_finset_of_finset, finset.image_insert] end
+
+open function
+lemma image_comp {f : hf → hf} {g : hf → hf} {s : hf} : image (f∘g) s = image f (image g s) :=
+begin unfold image, rewrite [*to_finset_of_finset, finset.image_comp] end
+
+lemma image_subset {a b : hf} (f : hf → hf) : a ⊆ b → image f a ⊆ image f b :=
+begin unfold [subset, image], intro h, rewrite *to_finset_of_finset, apply finset.image_subset f h end
+
+theorem image_union (f : hf → hf) (s t : hf) : image f (s ∪ t) = image f s ∪ image f t :=
+begin unfold [image, union], rewrite [*to_finset_of_finset, finset.image_union] end
+
+/- powerset -/
+definition powerset (s : hf) : hf :=
+of_finset (finset.image of_finset (finset.powerset (to_finset s)))
+
+prefix [priority hf.prio] `𝒫`:100 := powerset
+
+theorem powerset_empty : 𝒫 ∅ = insert ∅ ∅ :=
+rfl
+
+theorem powerset_insert {a : hf} {s : hf} : a ∉ s → 𝒫 (insert a s) = 𝒫 s ∪ image (insert a) (𝒫 s) :=
+begin unfold [mem, powerset, insert, union, image], rewrite [*to_finset_of_finset], intro h,
+      have (λ (x : finset hf), of_finset (finset.insert a x)) = (λ (x : finset hf), of_finset (finset.insert a (to_finset (of_finset x)))), from
+        funext (λ x, by rewrite to_finset_of_finset),
+      rewrite [finset.powerset_insert h, finset.image_union, -*finset.image_comp, ↑comp, this]
+end
+
+theorem mem_powerset_iff_subset (s : hf) : ∀ x : hf, x ∈ 𝒫 s ↔ x ⊆ s :=
+begin
+  intro x, unfold [mem, powerset, subset], rewrite [to_finset_of_finset, finset.mem_image_eq], apply iff.intro,
+  suppose (∃ (w : finset hf), finset.mem w (finset.powerset (to_finset s)) ∧ of_finset w = x),
+    obtain w h₁ h₂, from this,
+    begin subst x, rewrite to_finset_of_finset, exact iff.mp !finset.mem_powerset_iff_subset h₁ end,
+  suppose finset.subset (to_finset x) (to_finset s),
+    have finset.mem (to_finset x) (finset.powerset (to_finset s)), from iff.mpr !finset.mem_powerset_iff_subset this,
+    exists.intro (to_finset x) (and.intro this (of_finset_to_finset x))
+end
+
+theorem subset_of_mem_powerset {s t : hf} (H : s ∈ 𝒫 t) : s ⊆ t :=
+iff.mp (mem_powerset_iff_subset t s) H
+
+theorem mem_powerset_of_subset {s t : hf} (H : s ⊆ t) : s ∈ 𝒫 t :=
+iff.mpr (mem_powerset_iff_subset t s) H
+
+theorem empty_mem_powerset (s : hf) : ∅ ∈ 𝒫 s :=
+mem_powerset_of_subset (empty_subset s)
+
+/- hf as lists -/
+open - [notation] list
+
+definition of_list (s : list hf) : hf :=
+@equiv.to_fun _ _ list_nat_equiv_nat s
+
+definition to_list (h : hf) : list hf :=
+@equiv.inv _ _ list_nat_equiv_nat h
+
+lemma to_list_of_list (s : list hf) : to_list (of_list s) = s :=
+@equiv.left_inv _ _ list_nat_equiv_nat s
+
+lemma of_list_to_list (s : hf) : of_list (to_list s) = s :=
+@equiv.right_inv _ _ list_nat_equiv_nat s
+
+lemma to_list_inj {s₁ s₂ : hf} : to_list s₁ = to_list s₂ → s₁ = s₂ :=
+λ h, function.injective_of_left_inverse of_list_to_list h
+
+lemma of_list_inj {s₁ s₂ : list hf} : of_list s₁ = of_list s₂ → s₁ = s₂ :=
+λ h, function.injective_of_left_inverse to_list_of_list h
+
+definition nil : hf :=
+of_list list.nil
+
+lemma empty_eq_nil : ∅ = nil :=
+rfl
+
+definition cons (a l : hf) : hf :=
+of_list (list.cons a (to_list l))
+
+infixr :: := cons
+
+lemma cons_ne_nil (a l : hf) : a::l ≠ nil :=
+by contradiction
+
+lemma head_eq_of_cons_eq {h₁ h₂ t₁ t₂ : hf} : (h₁::t₁) = (h₂::t₂) → h₁ = h₂ :=
+begin unfold cons, intro h, apply list.head_eq_of_cons_eq (of_list_inj h) end
+
+lemma tail_eq_of_cons_eq {h₁ h₂ t₁ t₂ : hf} : (h₁::t₁) = (h₂::t₂) → t₁ = t₂ :=
+begin unfold cons, intro h, apply to_list_inj (list.tail_eq_of_cons_eq (of_list_inj h)) end
+
+lemma cons_inj {a : hf} : injective (cons a) :=
+take l₁ l₂, assume Pe, tail_eq_of_cons_eq Pe
+
+/- append -/
+definition append (l₁ l₂ : hf) : hf :=
+of_list (list.append (to_list l₁) (to_list l₂))
+
+notation l₁ ++ l₂ := append l₁ l₂
+
+attribute [simp]
+theorem append_nil_left (t : hf) : nil ++ t = t :=
+begin unfold [nil, append], rewrite [to_list_of_list, list.append_nil_left, of_list_to_list] end
+
+attribute [simp]
+theorem append_cons (x s t : hf) : (x::s) ++ t = x::(s ++ t) :=
+begin unfold [cons, append], rewrite [*to_list_of_list, list.append_cons] end
+
+attribute [simp]
+theorem append_nil_right (t : hf) : t ++ nil = t :=
+begin unfold [nil, append], rewrite [to_list_of_list, list.append_nil_right, of_list_to_list] end
+
+attribute [simp]
+theorem append.assoc (s t u : hf) : s ++ t ++ u = s ++ (t ++ u) :=
+begin unfold append, rewrite [*to_list_of_list, list.append.assoc] end
+
+/- length -/
+definition length (l : hf) : nat :=
+list.length (to_list l)
+
+attribute [simp]
+theorem length_nil : length nil = 0 :=
+begin unfold [length, nil] end
+
+attribute [simp]
+theorem length_cons (x t : hf) : length (x::t) = length t + 1 :=
+begin unfold [length, cons], rewrite to_list_of_list end
+
+attribute [simp]
+theorem length_append (s t : hf) : length (s ++ t) = length s + length t :=
+begin unfold [length, append], rewrite [to_list_of_list, list.length_append] end
+
+theorem eq_nil_of_length_eq_zero {l : hf} : length l = 0 → l = nil :=
+begin unfold [length, nil], intro h, rewrite [-list.eq_nil_of_length_eq_zero h, of_list_to_list] end
+
+theorem ne_nil_of_length_eq_succ {l : hf} {n : nat} : length l = succ n → l ≠ nil :=
+begin unfold [length, nil], intro h₁ h₂, subst l, rewrite to_list_of_list at h₁, contradiction end
+
+/- head and tail -/
+definition head (l : hf) : hf :=
+list.head (to_list l)
+
+attribute [simp]
+theorem head_cons (a l : hf) : head (a::l) = a :=
+begin unfold [head, cons], rewrite to_list_of_list end
+
+private lemma to_list_ne_list_nil {s : hf} : s ≠ nil → to_list s ≠ list.nil :=
+begin
+  unfold nil,
+  intro h,
+  suppose to_list s = list.nil,
+  by rewrite [-this at h, of_list_to_list at h]; exact absurd rfl h
+end
+
+attribute [simp]
+theorem head_append (t : hf) {s : hf} : s ≠ nil → head (s ++ t) = head s :=
+begin
+  unfold [nil, head, append], rewrite to_list_of_list,
+  suppose s ≠ of_list list.nil,
+  by rewrite [list.head_append _ (to_list_ne_list_nil this)]
+end
+
+definition tail (l : hf) : hf :=
+of_list (list.tail (to_list l))
+
+attribute [simp]
+theorem tail_nil : tail nil = nil :=
+begin unfold [tail, nil] end
+
+attribute [simp]
+theorem tail_cons (a l : hf) : tail (a::l) = l :=
+begin unfold [tail, cons], rewrite [to_list_of_list, list.tail_cons, of_list_to_list] end
+
+theorem cons_head_tail {l : hf} : l ≠ nil → (head l)::(tail l) = l :=
+begin
+  unfold [nil, head, tail, cons],
+  suppose l ≠ of_list list.nil,
+  by rewrite [to_list_of_list, list.cons_head_tail (to_list_ne_list_nil this), of_list_to_list]
+end
+end hf

old_library/data/hlist.lean

@@ -0,0 +1,93 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+
+Heterogeneous lists
+-/
+import data.list logic.cast
+open list
+
+inductive hlist {A : Type} (B : A → Type) : list A → Type :=
+| nil {} : hlist B []
+| cons   : ∀ {a : A}, B a → ∀ {l : list A}, hlist B l → hlist B (a::l)
+
+namespace hlist
+variables {A : Type} {B : A → Type}
+
+definition head : Π {a l}, hlist B (a :: l) → B a
+| a l (cons b h) := b
+
+lemma head_cons : ∀ {a l} (b : B a) (h : hlist B l), head (cons b h) = b :=
+sorry -- by intros; reflexivity
+
+definition tail : Π {a l}, hlist B (a :: l) → hlist B l
+| a l (cons b h) := h
+
+lemma tail_cons : ∀ {a l} (b : B a) (h : hlist B l), tail (cons b h) = h :=
+sorry -- by intros; reflexivity
+
+lemma eta_cons : ∀ {a l} (h : hlist B (a::l)), h = cons (head h) (tail h) :=
+sorry -- begin intros, cases h, esimp end
+
+lemma eta_nil : ∀ (h : hlist B []), h = nil :=
+sorry -- begin intros, cases h, esimp end
+
+definition append : Π {l₁ l₂}, hlist B l₁ → hlist B l₂ → hlist B (l₁++l₂)
+| []     l₂ nil         h₂ := h₂
+| (a::l) l₂ (cons b h₁) h₂ := cons b (append h₁ h₂)
+
+lemma append_nil_left : ∀ {l} (h : hlist B l), append nil h = h :=
+sorry -- by intros; reflexivity
+
+lemma eq_rec_on_cons : ∀ {a₁ a₂ l₁ l₂} (b : B a₁) (h : hlist B l₁) (e : a₁::l₁ = a₂::l₂),
+                         eq.rec_on e (cons b h) = cons (eq.rec_on (head_eq_of_cons_eq e) b) (eq.rec_on (tail_eq_of_cons_eq e) h) :=
+sorry
+/-
+begin
+  intros, injection e with e₁ e₂, revert e, subst a₂, subst l₂, intro e, esimp
+end
+-/
+
+local attribute list.append [reducible]
+lemma append_nil_right : ∀ {l} (h : hlist B l), append h nil = eq.rec_on (eq.symm (list.append_nil_right l)) h
+:= sorry
+/-
+| []     nil        := by esimp
+| (a::l) (cons b h) :=
+  begin
+    change (cons b (append h nil)) = (eq.symm (list.append_nil_right (a :: l))) ▹ cons b h,
+    rewrite [append_nil_right h], xrewrite eq_rec_on_cons
+  end
+-/
+
+lemma append_nil_right_heq {l} (h : hlist B l) : append h nil == h :=
+sorry -- by rewrite append_nil_right; apply eq_rec_heq
+
+section get
+variables [decA : decidable_eq A]
+include decA
+
+definition get {a : A} : ∀ {l : list A}, hlist B l → a ∈ l → B a
+| []     nil        e := absurd e (not_mem_nil a)
+| (t::l) (cons b h) e :=
+  or.by_cases (eq_or_mem_of_mem_cons e)
+    (suppose a = t, eq.rec_on (eq.symm this) b)
+    (suppose a ∈ l, get h this)
+end get
+
+section map
+variable {C : A → Type}
+variable (f : Π ⦃a⦄, B a → C a)
+
+definition map : ∀ {l}, hlist B l → hlist C l
+| []     nil        := nil
+| (a::l) (cons b h) := cons (f b) (map h)
+
+lemma map_nil : map f nil = nil :=
+rfl
+
+lemma map_cons : ∀ {a l} (b : B a) (h : hlist B l), map f (cons b h) = cons (f b) (map f h) :=
+sorry -- by intros; reflexivity
+end map
+end hlist

old_library/data/int/basic.lean

@@ -0,0 +1,604 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn, Jeremy Avigad
+
+The integers, with addition, multiplication, and subtraction. The representation of the integers is
+chosen to compute efficiently.
+
+To faciliate proving things about these operations, we show that the integers are a quotient of
+ℕ × ℕ with the usual equivalence relation, ≡, and functions
+
+  abstr : ℕ × ℕ → ℤ
+  repr : ℤ → ℕ × ℕ
+
+satisfying:
+
+  abstr_repr (a : ℤ) : abstr (repr a) = a
+  repr_abstr (p : ℕ × ℕ) : repr (abstr p) ≡ p
+  abstr_eq (p q : ℕ × ℕ) : p ≡ q → abstr p = abstr q
+
+For example, to "lift" statements about add to statements about padd, we need to prove the
+following:
+
+  repr_add (a b : ℤ) : repr (a + b) = padd (repr a) (repr b)
+  padd_congr (p p' q q' : ℕ × ℕ) (H1 : p ≡ p') (H2 : q ≡ q') : padd p q ≡ p' q'
+
+-/
+import data.nat.sub algebra.relation data.prod
+open eq.ops
+open prod relation nat
+open decidable binary
+
+/- the type of integers -/
+
+inductive int : Type :=
+| of_nat : nat → int
+| neg_succ_of_nat : nat → int
+
+notation `ℤ` := int
+-- [coercion]
+attribute [reducible, constructor]
+definition int.of_num (n : num) : ℤ :=
+int.of_nat (nat.of_num n)
+
+namespace int
+
+-- attribute int.of_nat [coercion]
+
+notation `-[1+ ` n `]` := int.neg_succ_of_nat n    -- for pretty-printing output
+
+protected definition prio : num := num.pred nat.prio
+
+attribute [instance, priority int.prio]
+definition int_has_zero : has_zero int :=
+has_zero.mk (of_nat 0)
+
+attribute [instance, priority int.prio]
+definition int_has_one : has_one int :=
+has_one.mk (of_nat 1)
+
+theorem of_nat_zero : of_nat (0:nat) = (0:int) :=
+rfl
+
+theorem of_nat_one : of_nat (1:nat) = (1:int) :=
+rfl
+
+/- definitions of basic functions -/
+
+definition neg_of_nat : ℕ → ℤ
+| 0        := 0
+| (succ m) := -[1+ m]
+
+definition sub_nat_nat (m n : ℕ) : ℤ :=
+match (n - m : nat) with
+  | 0        := of_nat (m - n)  -- m ≥ n
+  | (succ k) := -[1+ k]         -- m < n, and n - m = succ k
+end
+
+protected definition neg (a : ℤ) : ℤ :=
+int.cases_on a neg_of_nat succ
+
+protected definition add : ℤ → ℤ → ℤ
+| (of_nat m) (of_nat n) := m + n
+| (of_nat m) -[1+ n]    := sub_nat_nat m (succ n)
+| -[1+ m]    (of_nat n) := sub_nat_nat n (succ m)
+| -[1+ m]    -[1+ n]    := neg_of_nat (succ m + succ n)
+
+protected definition mul : ℤ → ℤ → ℤ
+| (of_nat m) (of_nat n) := m * n
+| (of_nat m) -[1+ n]    := neg_of_nat (m * succ n)
+| -[1+ m]    (of_nat n) := neg_of_nat (succ m * n)
+| -[1+ m]    -[1+ n]    := succ m * succ n
+
+/- notation -/
+
+attribute [instance, priority int.prio]
+definition int_has_add : has_add int := has_add.mk int.add
+attribute [instance, priority int.prio]
+definition int_has_neg : has_neg int := has_neg.mk int.neg
+attribute [instance, priority int.prio]
+definition int_has_mul : has_mul int := has_mul.mk int.mul
+
+lemma mul_of_nat_of_nat   (m n : nat) : of_nat m * of_nat n = of_nat (m * n) :=
+rfl
+
+lemma mul_of_nat_neg_succ_of_nat (m n : nat) : of_nat m * -[1+ n] = neg_of_nat (m * succ n) :=
+rfl
+
+lemma mul_neg_succ_of_nat_of_nat (m n : nat) : -[1+ m] * of_nat n = neg_of_nat (succ m * n) :=
+rfl
+
+lemma mul_neg_succ_of_nat_neg_succ_of_nat (m n : nat) : -[1+ m] * -[1+ n] = succ m * succ n :=
+rfl
+
+/- some basic functions and properties -/
+
+theorem of_nat.inj {m n : ℕ} (H : of_nat m = of_nat n) : m = n :=
+int.no_confusion H imp.id
+
+theorem eq_of_of_nat_eq_of_nat {m n : ℕ} (H : of_nat m = of_nat n) : m = n :=
+of_nat.inj H
+
+theorem of_nat_eq_of_nat_iff (m n : ℕ) : of_nat m = of_nat n ↔ m = n :=
+iff.intro of_nat.inj !congr_arg
+
+theorem neg_succ_of_nat.inj {m n : ℕ} (H : neg_succ_of_nat m = neg_succ_of_nat n) : m = n :=
+int.no_confusion H imp.id
+
+theorem neg_succ_of_nat_eq (n : ℕ) : -[1+ n] = -(n + 1) := rfl
+
+private definition has_decidable_eq₂ : Π (a b : ℤ), decidable (a = b)
+| (of_nat m) (of_nat n) := decidable_of_decidable_of_iff
+    (nat.has_decidable_eq m n) (iff.symm (of_nat_eq_of_nat_iff m n))
+| (of_nat m) -[1+ n]    := inr (by contradiction)
+| -[1+ m]    (of_nat n) := inr (by contradiction)
+| -[1+ m]    -[1+ n]    := if H : m = n then
+    inl (congr_arg neg_succ_of_nat H) else inr (not.mto neg_succ_of_nat.inj H)
+
+attribute [instance, priority int.prio]
+definition has_decidable_eq : decidable_eq ℤ := has_decidable_eq₂
+
+theorem of_nat_add (n m : nat) : of_nat (n + m) = of_nat n + of_nat m := rfl
+
+theorem of_nat_succ (n : ℕ) : of_nat (succ n) = of_nat n + 1 := rfl
+
+theorem of_nat_mul (n m : ℕ) : of_nat (n * m) = of_nat n * of_nat m := rfl
+
+theorem sub_nat_nat_of_ge {m n : ℕ} (H : m ≥ n) : sub_nat_nat m n = of_nat (m - n) :=
+show sub_nat_nat m n = nat.cases_on 0 (m -[nat] n) _, from (sub_eq_zero_of_le H) ▸ rfl
+
+section
+local attribute sub_nat_nat [reducible]
+theorem sub_nat_nat_of_lt {m n : ℕ} (H : m < n) : sub_nat_nat m n = -[1+ pred (n - m)] :=
+have H1 : n - m = succ (pred (n - m)), from eq.symm (succ_pred_of_pos (nat.sub_pos_of_lt H)),
+show sub_nat_nat m n = nat.cases_on (succ (nat.pred (n - m))) (m -[nat] n) _, from H1 ▸ rfl
+end
+
+definition nat_abs (a : ℤ) : ℕ := int.cases_on a id succ
+
+theorem nat_abs_of_nat (n : ℕ) : nat_abs n = n := rfl
+
+theorem eq_zero_of_nat_abs_eq_zero : Π {a : ℤ}, nat_abs a = 0 → a = 0
+| (of_nat m) H := congr_arg of_nat H
+| -[1+ m']   H := absurd H !succ_ne_zero
+
+theorem nat_abs_zero : nat_abs (0:int) = (0:nat) :=
+rfl
+
+theorem nat_abs_one : nat_abs (1:int) = (1:nat) :=
+rfl
+
+/- int is a quotient of ordered pairs of natural numbers -/
+
+protected definition equiv (p q : ℕ × ℕ) : Prop :=  pr1 p + pr2 q = pr2 p + pr1 q
+
+local infix ≡ := int.equiv
+
+attribute [refl]
+protected theorem equiv.refl {p : ℕ × ℕ} : p ≡ p := !add.comm
+
+local attribute int.equiv [reducible]
+
+attribute [symm]
+protected theorem equiv.symm {p q : ℕ × ℕ} (H : p ≡ q) : q ≡ p :=
+by simp
+
+attribute [trans]
+protected theorem equiv.trans {p q r : ℕ × ℕ} (H1 : p ≡ q) (H2 : q ≡ r) : p ≡ r :=
+add.right_cancel (calc
+   pr1 p + pr2 r + pr2 q = pr1 p + pr2 q + pr2 r : by simp_nohyps
+                     ... = pr2 p + pr1 r + pr2 q : by simp)
+
+protected theorem equiv_equiv : is_equivalence int.equiv :=
+is_equivalence.mk @equiv.refl @equiv.symm @equiv.trans
+
+protected theorem equiv_cases {p q : ℕ × ℕ} (H : p ≡ q) :
+    (pr1 p ≥ pr2 p ∧ pr1 q ≥ pr2 q) ∨ (pr1 p < pr2 p ∧ pr1 q < pr2 q) :=
+or.elim (@le_or_gt _ _ (pr2 p) (pr1 p))
+  (suppose pr1 p ≥ pr2 p,
+    have pr2 p + pr1 q ≥ pr2 p + pr2 q, from H ▸ add_le_add_right this (pr2 q),
+    or.inl (and.intro `pr1 p ≥ pr2 p` (le_of_add_le_add_left this)))
+  (suppose H₁ : pr1 p < pr2 p,
+    have pr2 p + pr1 q < pr2 p + pr2 q, from H ▸ add_lt_add_right H₁ (pr2 q),
+    or.inr (and.intro H₁ (lt_of_add_lt_add_left this)))
+
+protected theorem equiv_of_eq {p q : ℕ × ℕ} (H : p = q) : p ≡ q := H ▸ equiv.refl
+
+/- the representation and abstraction functions -/
+
+definition abstr (a : ℕ × ℕ) : ℤ := sub_nat_nat (pr1 a) (pr2 a)
+
+theorem abstr_of_ge {p : ℕ × ℕ} (H : pr1 p ≥ pr2 p) : abstr p = of_nat (pr1 p - pr2 p) :=
+sub_nat_nat_of_ge H
+
+theorem abstr_of_lt {p : ℕ × ℕ} (H : pr1 p < pr2 p) :
+  abstr p = -[1+ pred (pr2 p - pr1 p)] :=
+sub_nat_nat_of_lt H
+
+definition repr : ℤ → ℕ × ℕ
+| (of_nat m) := (m, 0)
+| -[1+ m]    := (0, succ m)
+
+theorem abstr_repr : Π (a : ℤ), abstr (repr a) = a
+| (of_nat m) := (sub_nat_nat_of_ge (zero_le m))
+| -[1+ m]    := rfl
+
+theorem repr_sub_nat_nat (m n : ℕ) : repr (sub_nat_nat m n) ≡ (m, n) :=
+nat.lt_ge_by_cases
+  (take H : m < n,
+    have H1 : repr (sub_nat_nat m n) = (0, n - m), by
+      rewrite [sub_nat_nat_of_lt H, -(succ_pred_of_pos (nat.sub_pos_of_lt H))],
+    H1⁻¹ ▸ (!zero_add ⬝ (nat.sub_add_cancel (le_of_lt H))⁻¹))
+  (take H : m ≥ n,
+    have H1 : repr (sub_nat_nat m n) = (m - n, 0), from sub_nat_nat_of_ge H ▸ rfl,
+    H1⁻¹ ▸ ((nat.sub_add_cancel H) ⬝ !zero_add⁻¹))
+
+theorem repr_abstr (p : ℕ × ℕ) : repr (abstr p) ≡ p :=
+!prod.eta ▸ !repr_sub_nat_nat
+
+theorem abstr_eq {p q : ℕ × ℕ} (Hequiv : p ≡ q) : abstr p = abstr q :=
+or.elim (int.equiv_cases Hequiv)
+  (and.rec (assume (Hp : pr1 p ≥ pr2 p) (Hq : pr1 q ≥ pr2 q),
+    have H : pr1 p - pr2 p = pr1 q - pr2 q, from
+      calc pr1 p - pr2 p
+           = pr1 p + pr2 q - pr2 q - pr2 p   : by rewrite nat.add_sub_cancel
+       ... = pr2 p + pr1 q - pr2 q - pr2 p   : Hequiv
+       ... = pr2 p + (pr1 q - pr2 q) - pr2 p : nat.add_sub_assoc Hq
+       ... = pr1 q - pr2 q + pr2 p - pr2 p   : by simp
+       ... = pr1 q - pr2 q                   : by rewrite nat.add_sub_cancel,
+    abstr_of_ge Hp ⬝ (H ▸ rfl) ⬝ (abstr_of_ge Hq)⁻¹))
+  (and.rec (assume (Hp : pr1 p < pr2 p) (Hq : pr1 q < pr2 q),
+    have H : pr2 p - pr1 p = pr2 q - pr1 q, from
+      calc pr2 p - pr1 p
+           = pr2 p + pr1 q - pr1 q - pr1 p   : by rewrite nat.add_sub_cancel
+       ... = pr1 p + pr2 q - pr1 q - pr1 p   : Hequiv
+       ... = pr1 p + (pr2 q - pr1 q) - pr1 p : nat.add_sub_assoc (le_of_lt Hq)
+       ... = pr2 q - pr1 q + pr1 p - pr1 p   : by rewrite add.comm
+       ... = pr2 q - pr1 q                   : by rewrite nat.add_sub_cancel,
+    abstr_of_lt Hp ⬝ (H ▸ rfl) ⬝ (abstr_of_lt Hq)⁻¹))
+
+theorem equiv_iff (p q : ℕ × ℕ) : (p ≡ q) ↔ (abstr p = abstr q) :=
+iff.intro abstr_eq (assume H, equiv.trans (H ▸ equiv.symm (repr_abstr p)) (repr_abstr q))
+
+theorem equiv_iff3 (p q : ℕ × ℕ) : (p ≡ q) ↔ ((p ≡ p) ∧ (q ≡ q) ∧ (abstr p = abstr q)) :=
+iff.trans !equiv_iff (iff.symm
+   (iff.trans (and_iff_right !equiv.refl) (and_iff_right !equiv.refl)))
+
+theorem eq_abstr_of_equiv_repr {a : ℤ} {p : ℕ × ℕ} (Hequiv : repr a ≡ p) : a = abstr p :=
+!abstr_repr⁻¹ ⬝ abstr_eq Hequiv
+
+theorem eq_of_repr_equiv_repr {a b : ℤ} (H : repr a ≡ repr b) : a = b :=
+eq_abstr_of_equiv_repr H ⬝ !abstr_repr
+
+section
+local attribute abstr [reducible]
+local attribute dist [reducible]
+theorem nat_abs_abstr : Π (p : ℕ × ℕ), nat_abs (abstr p) = dist (pr1 p) (pr2 p)
+| (m, n) := nat.lt_ge_by_cases
+  (assume H : m < n,
+    calc
+      nat_abs (abstr (m, n)) = nat_abs (-[1+ pred (n - m)]) : int.abstr_of_lt H
+        ... = n - m               : succ_pred_of_pos (nat.sub_pos_of_lt H)
+        ... = dist m n            : dist_eq_sub_of_le (le_of_lt H))
+  (assume H : m ≥ n, (abstr_of_ge H)⁻¹ ▸ (dist_eq_sub_of_ge H)⁻¹)
+end
+
+theorem cases_of_nat_succ (a : ℤ) : (∃n : ℕ, a = of_nat n) ∨ (∃n : ℕ, a = - (of_nat (succ n))) :=
+int.cases_on a (take m, or.inl (exists.intro _ rfl)) (take m, or.inr (exists.intro _ rfl))
+
+theorem cases_of_nat (a : ℤ) : (∃n : ℕ, a = of_nat n) ∨ (∃n : ℕ, a = - of_nat n) :=
+or.imp_right (Exists.rec (take n, (exists.intro _))) !cases_of_nat_succ
+
+theorem by_cases_of_nat {P : ℤ → Prop} (a : ℤ)
+    (H1 : ∀n : ℕ, P (of_nat n)) (H2 : ∀n : ℕ, P (- of_nat n)) :
+  P a :=
+or.elim (cases_of_nat a)
+  (assume H, obtain (n : ℕ) (H3 : a = n), from H, H3⁻¹ ▸ H1 n)
+  (assume H, obtain (n : ℕ) (H3 : a = -n), from H, H3⁻¹ ▸ H2 n)
+
+theorem by_cases_of_nat_succ {P : ℤ → Prop} (a : ℤ)
+    (H1 : ∀n : ℕ, P (of_nat n)) (H2 : ∀n : ℕ, P (- of_nat (succ n))) :
+  P a :=
+or.elim (cases_of_nat_succ a)
+  (assume H, obtain (n : ℕ) (H3 : a = n), from H, H3⁻¹ ▸ H1 n)
+  (assume H, obtain (n : ℕ) (H3 : a = -(succ n)), from H, H3⁻¹ ▸ H2 n)
+
+/-
+   int is a ring
+-/
+
+/- addition -/
+
+definition padd (p q : ℕ × ℕ) : ℕ × ℕ := (pr1 p + pr1 q, pr2 p + pr2 q)
+
+theorem repr_add : Π (a b : ℤ), repr (add a b) ≡ padd (repr a) (repr b)
+| (of_nat m) (of_nat n) := !equiv.refl
+| (of_nat m) -[1+ n]    :=
+  begin
+    change repr (sub_nat_nat m (succ n)) ≡ (m + 0, 0 + succ n),
+    rewrite [zero_add, add_zero],
+    apply repr_sub_nat_nat
+  end
+| -[1+ m]    (of_nat n) :=
+  begin
+    change repr (-[1+ m] + n) ≡ (0 + n, succ m + 0),
+    rewrite [zero_add, add_zero],
+    apply repr_sub_nat_nat
+  end
+| -[1+ m]    -[1+ n]    := !repr_sub_nat_nat
+
+theorem padd_congr {p p' q q' : ℕ × ℕ} (Ha : p ≡ p') (Hb : q ≡ q') : padd p q ≡ padd p' q' :=
+calc pr1 p + pr1 q + (pr2 p' + pr2 q')
+        = pr1 p + pr2 p' + (pr1 q + pr2 q') : by simp_nohyps
+    ... = pr2 p + pr1 p' + (pr2 q + pr1 q') : by simp
+    ... = pr2 p + pr2 q + (pr1 p' + pr1 q') : by simp_nohyps
+
+theorem padd_comm (p q : ℕ × ℕ) : padd p q = padd q p :=
+calc (pr1 p + pr1 q, pr2 p + pr2 q) = (pr1 q + pr1 p, pr2 q + pr2 p) : by simp
+
+theorem padd_assoc (p q r : ℕ × ℕ) : padd (padd p q) r = padd p (padd q r) :=
+calc (pr1 p + pr1 q + pr1 r, pr2 p + pr2 q + pr2 r)
+     = (pr1 p + (pr1 q + pr1 r), pr2 p + (pr2 q + pr2 r)) : by simp
+
+protected theorem add_comm (a b : ℤ) : a + b = b + a :=
+eq_of_repr_equiv_repr (equiv.trans !repr_add
+   (equiv.symm (!padd_comm ▸ !repr_add)))
+
+protected theorem add_assoc (a b c : ℤ) : a + b + c = a + (b + c) :=
+eq_of_repr_equiv_repr (calc
+         repr (a + b + c)
+       ≡ padd (repr (a + b)) (repr c)           : repr_add
+  ...  ≡ padd (padd (repr a) (repr b)) (repr c) : padd_congr !repr_add !equiv.refl
+  ...  = padd (repr a) (padd (repr b) (repr c)) : !padd_assoc
+  ...  ≡ padd (repr a) (repr (b + c))           : padd_congr !equiv.refl !repr_add
+  ...  ≡ repr (a + (b + c))                     : repr_add)
+
+protected theorem add_zero : Π (a : ℤ), a + 0 = a := int.rec (λm, rfl) (λm, rfl)
+
+protected theorem zero_add (a : ℤ) : 0 + a = a := !int.add_comm ▸ !int.add_zero
+
+/- negation -/
+
+definition pneg (p : ℕ × ℕ) : ℕ × ℕ := (pr2 p, pr1 p)
+
+-- note: this is =, not just ≡
+theorem repr_neg : Π (a : ℤ), repr (- a) = pneg (repr a)
+| 0        := rfl
+| (succ m) := rfl
+| -[1+ m]  := rfl
+
+theorem pneg_congr {p p' : ℕ × ℕ} (H : p ≡ p') : pneg p ≡ pneg p' := eq.symm H
+
+theorem pneg_pneg (p : ℕ × ℕ) : pneg (pneg p) = p := !prod.eta
+
+theorem nat_abs_neg (a : ℤ) : nat_abs (-a) = nat_abs a :=
+calc
+  nat_abs (-a) = nat_abs (abstr (repr (-a))) : abstr_repr
+    ... = nat_abs (abstr (pneg (repr a))) : repr_neg
+    ... = dist (pr1 (pneg (repr a))) (pr2 (pneg (repr a))) : nat_abs_abstr
+    ... = dist (pr2 (pneg (repr a))) (pr1 (pneg (repr a))) : dist.comm
+    ... = nat_abs (abstr (repr a)) : nat_abs_abstr
+    ... = nat_abs a : abstr_repr
+
+theorem padd_pneg (p : ℕ × ℕ) : padd p (pneg p) ≡ (0, 0) :=
+show pr1 p + pr2 p + 0 = pr2 p + pr1 p + 0, from !nat.add_comm ▸ rfl
+
+theorem padd_padd_pneg (p q : ℕ × ℕ) : padd (padd p q) (pneg q) ≡ p :=
+by unfold [padd, pneg]; simp
+
+protected theorem add_left_inv (a : ℤ) : -a + a = 0 :=
+have H : repr (-a + a) ≡ repr 0, from
+  calc
+    repr (-a + a) ≡ padd (repr (neg a)) (repr a) : repr_add
+      ... = padd (pneg (repr a)) (repr a) : repr_neg
+      ... ≡ repr 0 : padd_pneg,
+eq_of_repr_equiv_repr H
+
+/- nat abs -/
+
+definition pabs (p : ℕ × ℕ) : ℕ := dist (pr1 p) (pr2 p)
+
+theorem pabs_congr {p q : ℕ × ℕ} (H : p ≡ q) : pabs p = pabs q :=
+calc
+  pabs p = nat_abs (abstr p) : nat_abs_abstr
+    ... = nat_abs (abstr q) : abstr_eq H
+    ... = pabs q : nat_abs_abstr
+
+theorem nat_abs_eq_pabs_repr (a : ℤ) : nat_abs a = pabs (repr a) :=
+calc
+  nat_abs a = nat_abs (abstr (repr a)) : abstr_repr
+    ... = pabs (repr a) : nat_abs_abstr
+
+theorem nat_abs_add_le (a b : ℤ) : nat_abs (a + b) ≤ nat_abs a + nat_abs b :=
+calc
+  nat_abs (a + b) = pabs (repr (a + b)) : nat_abs_eq_pabs_repr
+              ... = pabs (padd (repr a) (repr b)) : pabs_congr !repr_add
+              ... ≤ pabs (repr a) + pabs (repr b) : dist_add_add_le_add_dist_dist
+              ... = pabs (repr a) + nat_abs b     : nat_abs_eq_pabs_repr
+              ... = nat_abs a + nat_abs b         : nat_abs_eq_pabs_repr
+
+theorem nat_abs_neg_of_nat (n : nat) : nat_abs (neg_of_nat n) = n :=
+begin cases n, reflexivity, reflexivity end
+
+section
+local attribute nat_abs [reducible]
+theorem nat_abs_mul : Π (a b : ℤ), nat_abs (a * b) = (nat_abs a) * (nat_abs b)
+| (of_nat m) (of_nat n) := rfl
+| (of_nat m) -[1+ n]    := by rewrite [mul_of_nat_neg_succ_of_nat, nat_abs_neg_of_nat]
+| -[1+ m]    (of_nat n) := by rewrite [mul_neg_succ_of_nat_of_nat, nat_abs_neg_of_nat]
+| -[1+ m]    -[1+ n]    := rfl
+end
+
+/- multiplication -/
+
+definition pmul (p q : ℕ × ℕ) : ℕ × ℕ :=
+  (pr1 p * pr1 q + pr2 p * pr2 q, pr1 p * pr2 q + pr2 p * pr1 q)
+
+theorem repr_neg_of_nat (m : ℕ) : repr (neg_of_nat m) = (0, m) :=
+nat.cases_on m rfl (take m', rfl)
+
+-- note: we have =, not just ≡
+theorem repr_mul : Π (a b : ℤ), repr (a * b) = pmul (repr a) (repr b)
+| (of_nat m) (of_nat n) := calc
+          (m * n + 0 * 0, m * 0 + 0) = (m * n + 0 * 0, m * 0 + 0 * n) : by rewrite *zero_mul
+| (of_nat m) -[1+ n]    := calc
+          repr ((m : int) * -[1+ n]) = (m * 0 + 0, m * succ n + 0 * 0) : repr_neg_of_nat
+            ... = (m * 0 + 0 * succ n, m * succ n + 0 * 0) : by rewrite *zero_mul
+| -[1+ m]    (of_nat n) := calc
+          repr (-[1+ m] * (n:int)) = (0 + succ m * 0, succ m * n) : repr_neg_of_nat
+            ... = (0 + succ m * 0, 0 + succ m * n) : nat.zero_add
+            ... = (0 * n + succ m * 0, 0 + succ m * n) : by rewrite zero_mul
+| -[1+ m]    -[1+ n]    := calc
+          (succ m * succ n, 0) = (succ m * succ n, 0 * succ n) : by rewrite zero_mul
+            ... = (0 + succ m * succ n, 0 * succ n) : nat.zero_add
+
+local attribute left_distrib right_distrib [simp]
+theorem equiv_mul_prep {xa ya xb yb xn yn xm ym : ℕ}
+  (H1 : xa + yb = ya + xb) (H2 : xn + ym = yn + xm) : xa*xn+ya*yn+(xb*ym+yb*xm) = xa*yn+ya*xn+(xb*xm+yb*ym) :=
+nat.add_right_cancel (
+calc xa*xn+ya*yn + (xb*ym+yb*xm) + (yb*xn+xb*yn + (xb*xn+yb*yn))
+         = (xa + yb)*xn + (ya + xb)*yn  + (xb*(xn + ym)) + (yb*(yn + xm)) : by simp_nohyps
+     ... = (ya + xb)*xn + (xa + yb)*yn  + (xb*(yn + xm)) + (yb*(xn + ym)) : by simp
+     ... = xa*yn+ya*xn + (xb*xm+yb*ym) + (yb*xn+xb*yn + (xb*xn+yb*yn))    : by simp_nohyps)
+
+theorem pmul_congr {p p' q q' : ℕ × ℕ} : p ≡ p' → q ≡ q' → pmul p q ≡ pmul p' q' := equiv_mul_prep
+
+theorem pmul_comm (p q : ℕ × ℕ) : pmul p q = pmul q p :=
+by unfold pmul; simp
+
+protected theorem mul_comm (a b : ℤ) : a * b = b * a :=
+eq_of_repr_equiv_repr
+  ((calc
+    repr (a * b) = pmul (repr a) (repr b) : repr_mul
+      ... = pmul (repr b) (repr a) : pmul_comm
+      ... = repr (b * a) : repr_mul) ▸ !equiv.refl)
+
+private theorem pmul_assoc_prep {p1 p2 q1 q2 r1 r2 : ℕ} :
+  ((p1*q1+p2*q2)*r1+(p1*q2+p2*q1)*r2, (p1*q1+p2*q2)*r2+(p1*q2+p2*q1)*r1) =
+   (p1*(q1*r1+q2*r2)+p2*(q1*r2+q2*r1), p1*(q1*r2+q2*r1)+p2*(q1*r1+q2*r2)) :=
+by simp
+
+theorem pmul_assoc (p q r: ℕ × ℕ) : pmul (pmul p q) r = pmul p (pmul q r) := pmul_assoc_prep
+
+protected theorem mul_assoc (a b c : ℤ) : (a * b) * c = a * (b * c) :=
+eq_of_repr_equiv_repr
+  ((calc
+    repr (a * b * c) = pmul (repr (a * b)) (repr c) : repr_mul
+      ... = pmul (pmul (repr a) (repr b)) (repr c) : repr_mul
+      ... = pmul (repr a) (pmul (repr b) (repr c)) : pmul_assoc
+      ... = pmul (repr a) (repr (b * c)) : repr_mul
+      ... = repr (a * (b * c)) : repr_mul) ▸ !equiv.refl)
+
+protected theorem mul_one : Π (a : ℤ), a * 1 = a
+| (of_nat m) := !int.zero_add -- zero_add happens to be def. = to this thm
+| -[1+ m]    := !nat.zero_add ▸ rfl
+
+protected theorem one_mul (a : ℤ) : 1 * a = a :=
+int.mul_comm a 1 ▸ int.mul_one a
+
+private theorem mul_distrib_prep {a1 a2 b1 b2 c1 c2 : ℕ} :
+ ((a1+b1)*c1+(a2+b2)*c2,     (a1+b1)*c2+(a2+b2)*c1) =
+ (a1*c1+a2*c2+(b1*c1+b2*c2), a1*c2+a2*c1+(b1*c2+b2*c1)) :=
+by simp
+
+protected theorem right_distrib (a b c : ℤ) : (a + b) * c = a * c + b * c :=
+eq_of_repr_equiv_repr
+  (calc
+    repr ((a + b) * c) = pmul (repr (a + b)) (repr c) : repr_mul
+      ... ≡ pmul (padd (repr a) (repr b)) (repr c)    : pmul_congr !repr_add equiv.refl
+      ... = padd (pmul (repr a) (repr c)) (pmul (repr b) (repr c)) : mul_distrib_prep
+      ... = padd (repr (a * c)) (pmul (repr b) (repr c))           : repr_mul
+      ... = padd (repr (a * c)) (repr (b * c))                     : repr_mul
+      ... ≡ repr (a * c + b * c)                                   : repr_add)
+
+protected theorem left_distrib (a b c : ℤ) : a * (b + c) = a * b + a * c :=
+calc
+  a * (b + c) = (b + c) * a : int.mul_comm
+    ... = b * a + c * a : int.right_distrib
+    ... = a * b + c * a : int.mul_comm
+    ... = a * b + a * c : int.mul_comm
+
+protected theorem zero_ne_one : (0 : int) ≠ 1 :=
+assume H : 0 = 1, !succ_ne_zero (of_nat.inj H)⁻¹
+
+protected theorem eq_zero_or_eq_zero_of_mul_eq_zero {a b : ℤ} (H : a * b = 0) : a = 0 ∨ b = 0 :=
+or.imp eq_zero_of_nat_abs_eq_zero eq_zero_of_nat_abs_eq_zero
+  (eq_zero_or_eq_zero_of_mul_eq_zero (by rewrite [-nat_abs_mul, H]))
+
+attribute [trans_instance]
+protected definition integral_domain : integral_domain int :=
+⦃integral_domain,
+  add            := int.add,
+  add_assoc      := int.add_assoc,
+  zero           := 0,
+  zero_add       := int.zero_add,
+  add_zero       := int.add_zero,
+  neg            := int.neg,
+  add_left_inv   := int.add_left_inv,
+  add_comm       := int.add_comm,
+  mul            := int.mul,
+  mul_assoc      := int.mul_assoc,
+  one            := 1,
+  one_mul        := int.one_mul,
+  mul_one        := int.mul_one,
+  left_distrib   := int.left_distrib,
+  right_distrib  := int.right_distrib,
+  mul_comm       := int.mul_comm,
+  zero_ne_one    := int.zero_ne_one,
+  eq_zero_or_eq_zero_of_mul_eq_zero := @int.eq_zero_or_eq_zero_of_mul_eq_zero⦄
+
+attribute [instance, priority int.prio]
+definition int_has_sub : has_sub int :=
+has_sub.mk has_sub.sub
+
+attribute [instance, priority int.prio]
+definition int_has_dvd : has_dvd int :=
+has_dvd.mk has_dvd.dvd
+
+/- additional properties -/
+theorem of_nat_sub {m n : ℕ} (H : m ≥ n) : of_nat (m - n) = of_nat m - of_nat n :=
+have m - n + n = m,     from nat.sub_add_cancel H,
+begin
+  symmetry,
+  apply sub_eq_of_eq_add,
+  rewrite [-of_nat_add, this]
+end
+
+theorem neg_succ_of_nat_eq' (m : ℕ) : -[1+ m] = -m - 1 :=
+by rewrite [neg_succ_of_nat_eq, neg_add]
+
+definition succ (a : ℤ) := a + (succ zero)
+definition pred (a : ℤ) := a - (succ zero)
+definition nat_succ_eq_int_succ (n : ℕ) : nat.succ n = int.succ n := rfl
+theorem pred_succ (a : ℤ) : pred (succ a) = a := !sub_add_cancel
+theorem succ_pred (a : ℤ) : succ (pred a) = a := !add_sub_cancel
+
+theorem neg_succ (a : ℤ) : -succ a = pred (-a) :=
+by rewrite [↑succ,neg_add]
+
+theorem succ_neg_succ (a : ℤ) : succ (-succ a) = -a :=
+by rewrite [neg_succ,succ_pred]
+
+theorem neg_pred (a : ℤ) : -pred a = succ (-a) :=
+by rewrite [↑pred,neg_sub,sub_eq_add_neg,add.comm]
+
+theorem pred_neg_pred (a : ℤ) : pred (-pred a) = -a :=
+by rewrite [neg_pred,pred_succ]
+
+theorem pred_nat_succ (n : ℕ) : pred (nat.succ n) = n := pred_succ n
+theorem neg_nat_succ (n : ℕ) : -nat.succ n = pred (-n) := !neg_succ
+theorem succ_neg_nat_succ (n : ℕ) : succ (-nat.succ n) = -n := !succ_neg_succ
+
+attribute [unfold 2]
+definition rec_nat_on {P : ℤ → Type} (z : ℤ) (H0 : P 0)
+  (Hsucc : Π⦃n : ℕ⦄, P n → P (succ n)) (Hpred : Π⦃n : ℕ⦄, P (-n) → P (-nat.succ n)) : P z :=
+int.rec (nat.rec H0 Hsucc) (λn, nat.rec H0 Hpred (nat.succ n)) z
+
+--the only computation rule of rec_nat_on which is not definitional
+theorem rec_nat_on_neg {P : ℤ → Type} (n : nat) (H0 : P zero)
+  (Hsucc : Π⦃n : nat⦄, P n → P (succ n)) (Hpred : Π⦃n : nat⦄, P (-n) → P (-nat.succ n))
+  : rec_nat_on (-nat.succ n) H0 Hsucc Hpred = Hpred (rec_nat_on (-n) H0 Hsucc Hpred) :=
+nat.rec rfl (λn H, rfl) n
+
+end int

old_library/data/int/countable.lean

@@ -0,0 +1,31 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+-/
+import data.equiv data.int.basic data.encodable data.countable
+open equiv bool sum
+
+namespace int
+definition int_equiv_bool_nat : int ≃ (bool × nat) :=
+equiv.mk
+  (λ i, match i with of_nat a := (tt, a) | neg_succ_of_nat a := (ff, a) end)
+  (λ p, match p with (tt, a) := of_nat a | (ff, a) := neg_succ_of_nat a end)
+  (λ i, begin cases i, repeat reflexivity end)
+  (λ p, begin cases p with b a, cases b, repeat reflexivity end)
+
+definition int_equiv_nat : int ≃ nat :=
+calc int ≃ (bool × nat)                : int_equiv_bool_nat
+     ... ≃ ((unit + unit) × nat)       : prod_congr bool_equiv_unit_sum_unit !_root_.equiv.refl
+     ... ≃ (unit × nat) + (unit × nat) : sum_prod_distrib
+     ... ≃ nat + nat                   : sum_congr !prod_unit_left !prod_unit_left
+     ... ≃ nat                         : nat_sum_nat_equiv_nat
+
+attribute [instance]
+definition encodable_int : encodable int :=
+encodable_of_equiv (_root_.equiv.symm int_equiv_nat)
+
+lemma countable_int : countable int :=
+countable_of_encodable encodable_int
+
+end int

old_library/data/int/default.lean

@@ -0,0 +1,6 @@
+/-
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+-/
+import .basic .order .div .power .gcd

old_library/data/int/div.lean

@@ -0,0 +1,710 @@
+/-
+Copyright (c) 2014 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+
+Definitions and properties of div and mod, following the SSReflect library.
+
+Following SSReflect and the SMTlib standard, we define a % b so that 0 ≤ a % b < |b| when b ≠ 0.
+-/
+import data.int.order data.nat.div
+-- open [coercion] [reducible] nat
+-- open [declaration] [class] nat (succ)
+open eq.ops
+
+namespace int
+
+/- definitions -/
+
+protected definition div (a b : ℤ) : ℤ :=
+sign b *
+  (match a with
+    | of_nat m := of_nat (m / (nat_abs b))
+    | -[1+m]   := -[1+ ((m:nat) / (nat_abs b))]
+  end)
+
+attribute [instance, priority int.prio]
+definition int_has_div : has_div int :=
+has_div.mk int.div
+
+lemma of_nat_div_eq (m : nat) (b : ℤ) : (of_nat m) / b = sign b * of_nat (m / (nat_abs b)) :=
+rfl
+
+lemma neg_succ_div_eq (m: nat) (b : ℤ) : -[1+m] / b = sign b * -[1+ (m / (nat_abs b))] :=
+rfl
+
+lemma div_def (a b : ℤ) : a / b =
+  sign b *
+    (match a with
+      | of_nat m := of_nat (m / (nat_abs b))
+      | -[1+m]   := -[1+ ((m:nat) / (nat_abs b))]
+    end) :=
+rfl
+
+protected definition mod (a b : ℤ) : ℤ := a - a / b * b
+
+attribute [instance, priority int.prio]
+definition int_has_mod : has_mod int :=
+has_mod.mk int.mod
+
+
+lemma mod_def (a b : ℤ) : a % b = a - a / b * b :=
+rfl
+
+notation [priority int.prio] a ≡ b `[mod `:0 c:0 `]` := a % c = b % c
+
+/- /  -/
+
+theorem of_nat_div (m n : nat) : of_nat (m / n) = (of_nat m) / (of_nat n) :=
+nat.cases_on n
+  (begin rewrite [of_nat_div_eq, of_nat_zero, sign_zero, zero_mul, nat.div_zero] end)
+  (take (n : nat), by rewrite [of_nat_div_eq, sign_of_succ, one_mul])
+
+theorem neg_succ_of_nat_div (m : nat) {b : ℤ} (H : b > 0) :
+  -[1+m] / b = -(m / b + 1) :=
+calc
+  -[1+m] / b = sign b * _         : rfl
+     ... = -[1+(m / (nat_abs b))] : by rewrite [sign_of_pos H, one_mul]
+     ... = -(m / b + 1)           : by rewrite [of_nat_div_eq, sign_of_pos H, one_mul]
+
+protected theorem div_neg (a b : ℤ) : a / -b = -(a / b) :=
+begin
+  induction a,
+    rewrite [*of_nat_div_eq, sign_neg, neg_mul_eq_neg_mul, nat_abs_neg],
+    rewrite [*neg_succ_div_eq, sign_neg, neg_mul_eq_neg_mul, nat_abs_neg],
+end
+
+theorem div_of_neg_of_pos {a b : ℤ} (Ha : a < 0) (Hb : b > 0) : a / b = -((-a - 1) / b + 1) :=
+obtain (m : nat) (H1 : a = -[1+m]), from exists_eq_neg_succ_of_nat Ha,
+calc
+  a / b = -(m / b + 1)         : by rewrite [H1, neg_succ_of_nat_div _ Hb]
+      ... = -((-a -1) / b + 1) : by rewrite [H1, neg_succ_of_nat_eq', neg_sub, sub_neg_eq_add,
+                                               add.comm 1, add_sub_cancel]
+
+protected theorem div_nonneg {a b : ℤ} (Ha : a ≥ 0) (Hb : b ≥ 0) : a / b ≥ 0 :=
+obtain (m : ℕ) (Hm : a = m), from exists_eq_of_nat Ha,
+obtain (n : ℕ) (Hn : b = n), from exists_eq_of_nat Hb,
+calc
+  a / b = m / n : by rewrite [Hm, Hn]
+      ... ≥ 0       : by rewrite -of_nat_div; apply trivial
+
+protected theorem div_nonpos {a b : ℤ} (Ha : a ≥ 0) (Hb : b ≤ 0) : a / b ≤ 0 :=
+calc
+  a / b = -(a / -b) : by rewrite [int.div_neg, neg_neg]
+      ... ≤ 0       : neg_nonpos_of_nonneg (int.div_nonneg Ha (neg_nonneg_of_nonpos Hb))
+
+theorem div_neg' {a b : ℤ} (Ha : a < 0) (Hb : b > 0) : a / b < 0 :=
+have -a - 1 ≥ 0, from le_sub_one_of_lt (neg_pos_of_neg Ha),
+have (-a - 1) / b + 1 > 0, from lt_add_one_of_le (int.div_nonneg this (le_of_lt Hb)),
+calc
+  a / b = -((-a - 1) / b + 1) : div_of_neg_of_pos Ha Hb
+      ... < 0                 : neg_neg_of_pos this
+
+protected theorem zero_div (b : ℤ) : 0 / b = 0 :=
+by krewrite [of_nat_div_eq, nat.zero_div, of_nat_zero, mul_zero]
+
+protected theorem div_zero (a : ℤ) : a / 0 = 0 :=
+by rewrite [div_def, sign_zero, zero_mul]
+
+protected theorem div_one (a : ℤ) : a / 1 = a :=
+have (1 : int) > 0, from dec_trivial,
+int.cases_on a
+  (take m : nat, by rewrite [-of_nat_one, -of_nat_div, nat.div_one])
+  (take m : nat, by rewrite [!neg_succ_of_nat_div this, -of_nat_one, -of_nat_div, nat.div_one])
+
+theorem eq_div_mul_add_mod (a b : ℤ) : a = a / b * b + a % b :=
+!add.comm ▸ eq_add_of_sub_eq rfl
+
+theorem div_eq_zero_of_lt {a b : ℤ} : 0 ≤ a → a < b → a / b = 0 :=
+int.cases_on a
+  (take (m : nat), assume H,
+    int.cases_on b
+      (take (n : nat),
+        assume H : m < n,
+        show m / n = 0,
+          by rewrite [-of_nat_div, nat.div_eq_zero_of_lt (lt_of_of_nat_lt_of_nat H)])
+      (take (n : nat),
+        assume H : m < -[1+n],
+        have H1 : ¬(m < -[1+n]), from dec_trivial,
+        absurd H H1))
+  (take (m : nat),
+    assume H : 0 ≤ -[1+m],
+    have ¬ (0 ≤ -[1+m]), from dec_trivial,
+    absurd H this)
+
+theorem div_eq_zero_of_lt_abs {a b : ℤ} (H1 : 0 ≤ a) (H2 : a < abs b) : a / b = 0 :=
+lt.by_cases
+  (suppose b < 0,
+    have a < -b, from abs_of_neg this ▸ H2,
+    calc
+      a / b = - (a / -b) : by rewrite [int.div_neg, neg_neg]
+          ... = 0         : by rewrite [div_eq_zero_of_lt H1 this, neg_zero])
+  (suppose b = 0, this⁻¹ ▸ !int.div_zero)
+  (suppose b > 0,
+    have a < b, from abs_of_pos this ▸ H2,
+    div_eq_zero_of_lt H1 this)
+
+private theorem add_mul_div_self_aux1 {a : ℤ} {k : ℕ} (n : ℕ) (H1 : a ≥ 0) (H2 : k > 0) :
+  (a + n * k) / k = a / k + n :=
+obtain (m : nat) (Hm : a = of_nat m), from exists_eq_of_nat H1,
+begin
+  subst Hm,
+  rewrite [-of_nat_mul, -of_nat_add, -*of_nat_div, -of_nat_add, !nat.add_mul_div_self H2]
+end
+
+private theorem add_mul_div_self_aux2 {a : ℤ} {k : ℕ} (n : ℕ) (H1 : a < 0) (H2 : k > 0) :
+  (a + n * k) / k = a / k + n :=
+obtain m (Hm : a = -[1+m]), from exists_eq_neg_succ_of_nat H1,
+or.elim (nat.lt_or_ge m (n * k))
+  (assume m_lt_nk : m < n * k,
+    have H3 : m + 1 ≤ n * k, from nat.succ_le_of_lt m_lt_nk,
+    have H4 : m / k + 1 ≤ n,
+      from nat.succ_le_of_lt (nat.div_lt_of_lt_mul m_lt_nk),
+    have (-[1+m] + n * k) / k = -[1+m] / k + n, from calc
+      (-[1+m] + n * k) / k
+            = of_nat ((k * n - (m + 1)) / k) :
+                by rewrite [add.comm, neg_succ_of_nat_eq, of_nat_div, mul.comm k n,
+                            of_nat_sub H3]
+        ... = of_nat (n - m / k - 1)         :
+                nat.mul_sub_div_of_lt (!nat.mul_comm ▸ m_lt_nk)
+        ... = -[1+m] / k + n                 :
+                by rewrite [nat.sub_sub, of_nat_sub H4, int.add_comm, sub_eq_add_neg,
+                            !neg_succ_of_nat_div (of_nat_lt_of_nat_of_lt H2),
+                            of_nat_add, of_nat_div],
+    Hm⁻¹ ▸ this)
+  (assume nk_le_m :  n * k ≤ m,
+    have -[1+m] / k + n = (-[1+m] + n * k) / k, from calc
+      -[1+m] / k + n
+            = -(of_nat ((m - n * k + n * k) / k) + 1) + n :
+                by rewrite [neg_succ_of_nat_div m (of_nat_lt_of_nat_of_lt H2),
+                            nat.sub_add_cancel nk_le_m, of_nat_div]
+        ... = -(of_nat ((m - n * k) / k + n) + 1) + n     : nat.add_mul_div_self H2
+        ... = -(of_nat (m - n * k) / k + 1)               :
+                   by rewrite [of_nat_add, *neg_add, add.right_comm, neg_add_cancel_right,
+                               of_nat_div]
+        ... = -[1+(m - n * k)] / k                        :
+                   neg_succ_of_nat_div _ (of_nat_lt_of_nat_of_lt H2)
+        ... = -(of_nat(m - n * k) + 1) / k                : rfl
+        ... = -(of_nat m - of_nat(n * k) + 1) / k         : of_nat_sub nk_le_m
+        ... = (-(of_nat m + 1) + n * k) / k               :
+                   by rewrite [sub_eq_add_neg, -*add.assoc, *neg_add, neg_neg, add.right_comm]
+        ... = (-[1+m] + n * k) / k                        : rfl,
+    Hm⁻¹ ▸ this⁻¹)
+
+private theorem add_mul_div_self_aux3 (a : ℤ) {b c : ℤ} (H1 : b ≥ 0) (H2 : c > 0) :
+    (a + b * c) / c = a / c + b :=
+obtain (n : nat) (Hn : b = of_nat n), from exists_eq_of_nat H1,
+obtain (k : nat) (Hk : c = of_nat k), from exists_eq_of_nat (le_of_lt H2),
+have knz : k ≠ 0, from assume kz, !lt.irrefl (kz ▸ Hk ▸ H2),
+have kgt0 : (#nat k > 0), from nat.pos_of_ne_zero knz,
+have H3 : (a + n * k) / k = a / k + n, from
+  or.elim (lt_or_ge a 0)
+    (assume Ha : a < 0, add_mul_div_self_aux2 _ Ha kgt0)
+    (assume Ha : a ≥ 0, add_mul_div_self_aux1 _ Ha kgt0),
+Hn⁻¹ ▸ Hk⁻¹ ▸ H3
+
+private theorem add_mul_div_self_aux4 (a b : ℤ) {c : ℤ} (H : c > 0) :
+    (a + b * c) / c = a / c + b :=
+or.elim (le.total 0 b)
+  (assume H1 : 0 ≤ b, add_mul_div_self_aux3 _ H1 H)
+  (assume H1 : 0 ≥ b,
+    eq.symm (calc
+      a / c + b = (a + b * c + -b * c) / c + b :
+                        by rewrite [-neg_mul_eq_neg_mul, add_neg_cancel_right]
+              ... = (a + b * c) / c + - b + b  :
+                        add_mul_div_self_aux3 _ (neg_nonneg_of_nonpos H1) H
+              ... = (a + b * c) / c            : neg_add_cancel_right))
+
+protected theorem add_mul_div_self (a b : ℤ) {c : ℤ} (H : c ≠ 0) :
+  (a + b * c) / c = a / c + b :=
+lt.by_cases
+  (assume H1 : 0 < c, !add_mul_div_self_aux4 H1)
+  (assume H1 : 0 = c, absurd H1⁻¹ H)
+  (assume H1 : 0 > c,
+    have H2 : -c > 0, from neg_pos_of_neg H1,
+    calc
+      (a + b * c) / c = - ((a + -b * -c) / -c) : by rewrite [int.div_neg, neg_mul_neg, neg_neg]
+                    ... = -(a / -c + -b)       : !add_mul_div_self_aux4 H2
+                    ... = a / c + b            : by rewrite [int.div_neg, neg_add, *neg_neg])
+
+protected theorem add_mul_div_self_left (a : ℤ) {b : ℤ} (c : ℤ) (H : b ≠ 0) :
+    (a + b * c) / b = a / b + c :=
+!mul.comm ▸ !int.add_mul_div_self H
+
+protected theorem mul_div_cancel (a : ℤ) {b : ℤ} (H : b ≠ 0) : a * b / b = a :=
+calc
+  a * b / b = (0 + a * b) / b : zero_add
+          ... = 0 / b + a     : !int.add_mul_div_self H
+          ... = a             : by rewrite [int.zero_div, zero_add]
+
+protected theorem mul_div_cancel_left {a : ℤ} (b : ℤ) (H : a ≠ 0) : a * b / a = b :=
+!mul.comm ▸ int.mul_div_cancel b H
+
+protected theorem div_self {a : ℤ} (H : a ≠ 0) : a / a = 1 :=
+!mul_one ▸ !int.mul_div_cancel_left H
+
+/- mod -/
+
+theorem of_nat_mod (m n : nat) : m % n = of_nat (m % n) :=
+have H : m = of_nat (m % n) + m / n * n, from calc
+  m = of_nat (m / n * n + m % n)              : nat.eq_div_mul_add_mod
+    ... = of_nat (m / n) * n + of_nat (m % n) : rfl
+    ... = m / n * n + of_nat (m % n)          : of_nat_div
+    ... = of_nat (m % n) + m / n * n          : add.comm,
+calc
+  m % n = m - m / n * n : rfl
+      ... = of_nat (m % n)  : sub_eq_of_eq_add H
+
+theorem neg_succ_of_nat_mod (m : ℕ) {b : ℤ} (bpos : b > 0) :
+  -[1+m] % b = b - 1 - m % b :=
+calc
+  -[1+m] % b = -(m + 1) - -[1+m] / b * b : rfl
+    ... = -(m + 1) - -(m / b + 1) * b    : neg_succ_of_nat_div _ bpos
+    ... = -m + -1 + (b + m / b * b)      :
+              by rewrite [neg_add, -neg_mul_eq_neg_mul, sub_neg_eq_add, right_distrib,
+                                 one_mul, (add.comm b)]
+    ... = b + -1 + (-m + m / b * b)      :
+              by rewrite [-*add.assoc, add.comm (-m), add.right_comm (-1), (add.comm b)]
+    ... = b - 1 - m % b                  :
+              by rewrite [(mod_def), *sub_eq_add_neg, neg_add, neg_neg]
+                -- it seems the parser has difficulty here, because "mod" is a token?
+
+theorem mod_neg (a b : ℤ) : a % -b = a % b :=
+calc
+  a % -b = a - (a / -b) * -b   : rfl
+       ... = a - -(a / b) * -b : int.div_neg
+       ... = a - a / b * b     : neg_mul_neg
+       ... = a % b             : rfl
+
+theorem mod_abs (a b : ℤ) : a % (abs b) = a % b :=
+abs.by_cases rfl !mod_neg
+
+theorem zero_mod (b : ℤ) : 0 % b = 0 :=
+by rewrite [(mod_def), int.zero_div, zero_mul, sub_zero]
+
+theorem mod_zero (a : ℤ) : a % 0 = a :=
+by rewrite [(mod_def), mul_zero, sub_zero]
+
+theorem mod_one (a : ℤ) : a % 1 = 0 :=
+calc
+  a % 1 = a - a / 1 * 1 : rfl
+      ... = 0 : by rewrite [mul_one, int.div_one, sub_self]
+
+private lemma of_nat_mod_abs (m : ℕ) (b : ℤ) : m % (abs b) = of_nat (m % (nat_abs b)) :=
+calc
+  m % (abs b) = m % (nat_abs b)            : of_nat_nat_abs
+            ... = of_nat (m % (nat_abs b)) : of_nat_mod
+
+private lemma of_nat_mod_abs_lt (m : ℕ) {b : ℤ} (H : b ≠ 0) : m % (abs b) < (abs b) :=
+have H1 : abs b > 0, from abs_pos_of_ne_zero H,
+have H2 : (#nat nat_abs b > 0), from lt_of_of_nat_lt_of_nat (!of_nat_nat_abs⁻¹ ▸ H1),
+calc
+  m % (abs b) = of_nat (m % (nat_abs b)) : of_nat_mod_abs m b
+        ... < nat_abs b : of_nat_lt_of_nat_of_lt (!nat.mod_lt H2)
+        ... = abs b       : of_nat_nat_abs _
+
+theorem mod_eq_of_lt {a b : ℤ} (H1 : 0 ≤ a) (H2 : a < b) : a % b = a :=
+obtain (m : nat) (Hm : a = of_nat m), from exists_eq_of_nat H1,
+obtain (n : nat) (Hn : b = of_nat n), from exists_eq_of_nat (le_of_lt (lt_of_le_of_lt H1 H2)),
+begin
+  revert H2,
+  rewrite [Hm, Hn, of_nat_mod, of_nat_lt_of_nat_iff, of_nat_eq_of_nat_iff],
+  apply nat.mod_eq_of_lt
+end
+
+theorem mod_nonneg (a : ℤ) {b : ℤ} (H : b ≠ 0) : a % b ≥ 0 :=
+have H1 : abs b > 0, from abs_pos_of_ne_zero H,
+have H2 : a % (abs b) ≥ 0, from
+  int.cases_on a
+    (take m : nat, (of_nat_mod_abs m b)⁻¹ ▸ of_nat_nonneg (nat.mod m (nat_abs b)))
+    (take m : nat,
+      have H3 : 1 + m % (abs b) ≤ (abs b),
+        from (!add.comm ▸ add_one_le_of_lt (of_nat_mod_abs_lt m H)),
+      calc
+        -[1+m] % (abs b) = abs b - 1 - m % (abs b) : neg_succ_of_nat_mod _ H1
+          ... = abs b - (1 + m % (abs b))          : by rewrite [*sub_eq_add_neg, neg_add, add.assoc]
+          ... ≥ 0                                  : iff.mpr !sub_nonneg_iff_le H3),
+!mod_abs ▸ H2
+
+theorem mod_lt (a : ℤ) {b : ℤ} (H : b ≠ 0) : a % b < (abs b) :=
+have H1 : abs b > 0, from abs_pos_of_ne_zero H,
+have H2 : a % (abs b) < abs b, from
+  int.cases_on a
+    (take m, of_nat_mod_abs_lt m H)
+    (take m : nat,
+      have H3 : abs b ≠ 0, from assume H', H (eq_zero_of_abs_eq_zero H'),
+      have H4 : 1 + m % (abs b) > 0,
+        from add_pos_of_pos_of_nonneg dec_trivial (mod_nonneg _ H3),
+      calc
+        -[1+m] % (abs b) = abs b - 1 - m % (abs b) : neg_succ_of_nat_mod _ H1
+          ... = abs b - (1 + m % (abs b))        : by rewrite [*sub_eq_add_neg, neg_add, add.assoc]
+          ... < abs b                            : sub_lt_self _ H4),
+!mod_abs ▸ H2
+
+theorem add_mul_mod_self {a b c : ℤ} : (a + b * c) % c = a % c :=
+decidable.by_cases
+  (assume cz : c = 0, by rewrite [cz, mul_zero, add_zero])
+  (assume cnz, by rewrite [(mod_def), !int.add_mul_div_self cnz, right_distrib,
+                            sub_add_eq_sub_sub_swap, add_sub_cancel])
+
+theorem add_mul_mod_self_left (a b c : ℤ) : (a + b * c) % b = a % b :=
+!mul.comm ▸ !add_mul_mod_self
+
+theorem add_mod_self {a b : ℤ} : (a + b) % b = a % b :=
+by rewrite -(int.mul_one b) at {1}; apply add_mul_mod_self_left
+
+theorem add_mod_self_left {a b : ℤ} : (a + b) % a = b % a :=
+!add.comm ▸ !add_mod_self
+
+theorem mod_add_mod (m n k : ℤ) : (m % n + k) % n = (m + k) % n :=
+by rewrite [eq_div_mul_add_mod m n at {2}, add.assoc, add.comm (m / n * n), add_mul_mod_self]
+
+theorem add_mod_mod (m n k : ℤ) : (m + n % k) % k = (m + n) % k :=
+by rewrite [add.comm, mod_add_mod, add.comm]
+
+theorem add_mod_eq_add_mod_right {m n k : ℤ} (i : ℤ) (H : m % n = k % n) :
+  (m + i) % n = (k + i) % n :=
+by rewrite [-mod_add_mod, -mod_add_mod k, H]
+
+theorem add_mod_eq_add_mod_left {m n k : ℤ} (i : ℤ) (H : m % n = k % n) :
+  (i + m) % n = (i + k) % n :=
+by rewrite [add.comm, add_mod_eq_add_mod_right _ H, add.comm]
+
+theorem mod_eq_mod_of_add_mod_eq_add_mod_right {m n k i : ℤ}
+    (H : (m + i) % n = (k + i) % n) :
+  m % n = k % n :=
+have H1 : (m + i + (-i)) % n = (k + i + (-i)) % n, from add_mod_eq_add_mod_right _ H,
+by rewrite [*add_neg_cancel_right at H1]; apply H1
+
+theorem mod_eq_mod_of_add_mod_eq_add_mod_left {m n k i : ℤ} :
+  (i + m) % n = (i + k) % n → m % n = k % n :=
+by rewrite [add.comm i m, add.comm i k]; apply mod_eq_mod_of_add_mod_eq_add_mod_right
+
+theorem mul_mod_left (a b : ℤ) : (a * b) % b = 0 :=
+by rewrite [-zero_add (a * b), add_mul_mod_self, zero_mod]
+
+theorem mul_mod_right (a b : ℤ) : (a * b) % a = 0 :=
+!mul.comm ▸ !mul_mod_left
+
+theorem mod_self {a : ℤ} : a % a = 0 :=
+decidable.by_cases
+  (assume H : a = 0, H⁻¹ ▸ !mod_zero)
+  (assume H : a ≠ 0,
+    calc
+      a % a = a - a / a * a : rfl
+          ... = 0 : by rewrite [!int.div_self H, one_mul, sub_self])
+
+theorem mod_lt_of_pos (a : ℤ) {b : ℤ} (H : b > 0) : a % b < b :=
+!abs_of_pos H ▸ !mod_lt (ne.symm (ne_of_lt H))
+
+/- properties of / and % -/
+
+theorem mul_div_mul_of_pos_aux {a : ℤ} (b : ℤ) {c : ℤ}
+  (H1 : a > 0) (H2 : c > 0) : a * b / (a * c) = b / c :=
+have H3 : a * c ≠ 0, from ne.symm (ne_of_lt (mul_pos H1 H2)),
+have H4 : a * (b % c) < a * c, from mul_lt_mul_of_pos_left (!mod_lt_of_pos H2)  H1,
+have H5 : a * (b % c) ≥ 0, from mul_nonneg (le_of_lt H1) (!mod_nonneg (ne.symm (ne_of_lt H2))),
+calc
+  a * b / (a * c) = a * (b / c * c + b % c) / (a * c) : eq_div_mul_add_mod
+
+    ... = (a * (b % c) + a * c * (b / c)) / (a * c)   :
+              by rewrite [!add.comm, int.left_distrib, mul.comm _ c, -!mul.assoc]
+    ... = a * (b % c) / (a * c) + b / c               : !int.add_mul_div_self_left H3
+    ... = 0 + b / c                                   : {!div_eq_zero_of_lt H5 H4}
+    ... = b / c                                       : zero_add
+
+theorem mul_div_mul_of_pos {a : ℤ} (b c : ℤ) (H : a > 0) : a * b / (a * c) = b / c :=
+lt.by_cases
+  (assume H1 : c < 0,
+    have H2 : -c > 0, from neg_pos_of_neg H1,
+    calc
+      a * b / (a * c) = - (a * b / (a * -c)) :
+                              by rewrite [-neg_mul_eq_mul_neg, int.div_neg, neg_neg]
+                    ... = - (b / -c)         : mul_div_mul_of_pos_aux _ H H2
+                    ... = b / c : by rewrite [int.div_neg, neg_neg])
+  (assume H1 : c = 0,
+    calc
+      a * b / (a * c) = 0       : by rewrite [H1, mul_zero, int.div_zero]
+                    ... = b / c : by rewrite [H1, int.div_zero])
+  (assume H1 : c > 0,
+    mul_div_mul_of_pos_aux _ H H1)
+
+theorem mul_div_mul_of_pos_left (a : ℤ) {b : ℤ} (c : ℤ) (H : b > 0) :
+  a * b / (c * b) = a / c :=
+!mul.comm ▸ !mul.comm ▸ !mul_div_mul_of_pos H
+
+theorem mul_mod_mul_of_pos {a : ℤ} (b c : ℤ) (H : a > 0) : a * b % (a * c) = a * (b % c) :=
+by rewrite [(mod_def), mod_def, !mul_div_mul_of_pos H, mul_sub_left_distrib, mul.left_comm]
+
+theorem lt_div_add_one_mul_self (a : ℤ) {b : ℤ} (H : b > 0) : a < (a / b + 1) * b :=
+have H : a - a / b * b < b, from !mod_lt_of_pos H,
+calc
+      a < a / b * b + b    : iff.mpr !lt_add_iff_sub_lt_left H
+    ... = (a / b + 1) * b  : by rewrite [right_distrib, one_mul]
+
+theorem div_le_of_nonneg_of_nonneg {a b : ℤ} (Ha : a ≥ 0) (Hb : b ≥ 0) : a / b ≤ a :=
+obtain (m : ℕ) (Hm : a = m), from exists_eq_of_nat Ha,
+obtain (n : ℕ) (Hn : b = n), from exists_eq_of_nat Hb,
+calc
+  a / b = of_nat (m / n) : by rewrite [Hm, Hn, of_nat_div]
+     ... ≤ m             : of_nat_le_of_nat_of_le !nat.div_le_self
+     ... = a             : Hm
+
+theorem abs_div_le_abs (a b : ℤ) : abs (a / b) ≤ abs a :=
+have H : ∀a b, b > 0 → abs (a / b) ≤ abs a, from
+  take a b,
+  assume H1 : b > 0,
+  or.elim (le_or_gt 0 a)
+    (assume H2 : 0 ≤ a,
+      have H3 : 0 ≤ b, from le_of_lt H1,
+      calc
+        abs (a / b) = a / b   : abs_of_nonneg (int.div_nonneg H2 H3)
+                  ... ≤ a     : div_le_of_nonneg_of_nonneg H2 H3
+                  ... = abs a : abs_of_nonneg H2)
+    (assume H2 : a < 0,
+      have H3 : -a - 1 ≥ 0, from le_sub_one_of_lt (neg_pos_of_neg H2),
+      have H4 : (-a - 1) / b + 1 ≥ 0,
+        from add_nonneg (int.div_nonneg H3 (le_of_lt H1)) (of_nat_le_of_nat_of_le !nat.zero_le),
+      have H5 : (-a - 1) / b ≤ -a - 1, from div_le_of_nonneg_of_nonneg H3 (le_of_lt H1),
+      calc
+        abs (a / b) = abs ((-a - 1) / b + 1) : by rewrite [div_of_neg_of_pos H2 H1, abs_neg]
+                  ... = (-a - 1) / b + 1     : abs_of_nonneg H4
+                  ... ≤ -a - 1 + 1           : add_le_add_right H5 _
+                  ... = abs a                : by rewrite [sub_add_cancel, abs_of_neg H2]),
+lt.by_cases
+  (assume H1 : b < 0,
+    calc
+      abs (a / b) = abs (a / -b) : by rewrite [int.div_neg, abs_neg]
+                ... ≤ abs a      : H _ _ (neg_pos_of_neg H1))
+  (assume H1 : b = 0,
+    calc
+      abs (a / b) = 0 : by rewrite [H1, int.div_zero, abs_zero]
+                ... ≤ abs a : abs_nonneg)
+  (assume H1 : b > 0, H _ _ H1)
+
+theorem div_mul_cancel_of_mod_eq_zero {a b : ℤ} (H : a % b = 0) : a / b * b = a :=
+by rewrite [eq_div_mul_add_mod a b at {2}, H, add_zero]
+
+theorem mul_div_cancel_of_mod_eq_zero {a b : ℤ} (H : a % b = 0) : b * (a / b) = a :=
+!mul.comm ▸ div_mul_cancel_of_mod_eq_zero H
+
+/- dvd -/
+
+theorem dvd_of_of_nat_dvd_of_nat {m n : ℕ} : of_nat m ∣ of_nat n → (#nat m ∣ n) :=
+nat.by_cases_zero_pos n
+  (assume H, dvd_zero m)
+  (take n' : ℕ,
+    assume H1 : (#nat n' > 0),
+    have H2 : of_nat n' > 0, from of_nat_pos H1,
+    assume H3 : of_nat m ∣ of_nat n',
+    dvd.elim H3
+      (take c,
+        assume H4 : of_nat n' = of_nat m * c,
+        have H5 : c > 0, from pos_of_mul_pos_left (H4 ▸ H2) !of_nat_nonneg,
+        obtain k (H6 : c = of_nat k), from exists_eq_of_nat (le_of_lt H5),
+        have H7 : n' = (#nat m * k), from (of_nat.inj (H6 ▸ H4)),
+        dvd.intro H7⁻¹))
+
+theorem of_nat_dvd_of_nat_of_dvd {m n : ℕ} (H : #nat m ∣ n) : of_nat m ∣ of_nat n :=
+dvd.elim H
+  (take k, assume H1 : #nat n = m * k,
+    dvd.intro (H1⁻¹ ▸ rfl))
+
+theorem of_nat_dvd_of_nat_iff (m n : ℕ) : of_nat m ∣ of_nat n ↔ m ∣ n :=
+iff.intro dvd_of_of_nat_dvd_of_nat of_nat_dvd_of_nat_of_dvd
+
+theorem dvd.antisymm {a b : ℤ} (H1 : a ≥ 0) (H2 : b ≥ 0) : a ∣ b → b ∣ a → a = b :=
+begin
+  rewrite [-abs_of_nonneg H1, -abs_of_nonneg H2, -*of_nat_nat_abs],
+  rewrite [*of_nat_dvd_of_nat_iff, *of_nat_eq_of_nat_iff],
+  apply nat.dvd.antisymm
+end
+
+theorem dvd_of_mod_eq_zero {a b : ℤ} (H : b % a = 0) : a ∣ b :=
+dvd.intro (!mul.comm ▸ div_mul_cancel_of_mod_eq_zero H)
+
+theorem mod_eq_zero_of_dvd {a b : ℤ} (H : a ∣ b) : b % a = 0 :=
+dvd.elim H (take z, assume H1 : b = a * z, H1⁻¹ ▸ !mul_mod_right)
+
+theorem dvd_iff_mod_eq_zero (a b : ℤ) : a ∣ b ↔ b % a = 0 :=
+iff.intro mod_eq_zero_of_dvd dvd_of_mod_eq_zero
+
+attribute [instance]
+definition dvd.decidable_rel : decidable_rel dvd :=
+take a n, decidable_of_decidable_of_iff _ (iff.symm !dvd_iff_mod_eq_zero)
+
+protected theorem div_mul_cancel {a b : ℤ} (H : b ∣ a) : a / b * b = a :=
+div_mul_cancel_of_mod_eq_zero (mod_eq_zero_of_dvd H)
+
+protected theorem mul_div_cancel' {a b : ℤ} (H : a ∣ b) : a * (b / a) = b :=
+!mul.comm ▸ !int.div_mul_cancel H
+
+protected theorem mul_div_assoc (a : ℤ) {b c : ℤ} (H : c ∣ b) : (a * b) / c = a * (b / c) :=
+decidable.by_cases
+  (assume cz : c = 0, by rewrite [cz, *int.div_zero, mul_zero])
+  (assume cnz : c ≠ 0,
+    obtain d (H' : b = d * c), from exists_eq_mul_left_of_dvd H,
+    by rewrite [H', -mul.assoc, *(!int.mul_div_cancel cnz)])
+
+theorem div_dvd_div {a b c : ℤ} (H1 : a ∣ b) (H2 : b ∣ c) : b / a ∣ c / a :=
+have H3 : b = b / a * a, from (int.div_mul_cancel H1)⁻¹,
+have H4 : c = c / a * a, from (int.div_mul_cancel (dvd.trans H1 H2))⁻¹,
+decidable.by_cases
+  (assume H5 : a = 0,
+    have H6: c / a = 0, from (congr_arg _ H5 ⬝ !int.div_zero),
+      H6⁻¹ ▸ !dvd_zero)
+  (assume H5 : a ≠ 0,
+    dvd_of_mul_dvd_mul_right H5 (H3 ▸ H4 ▸ H2))
+
+protected theorem div_eq_iff_eq_mul_right {a b : ℤ} (c : ℤ) (H : b ≠ 0) (H' : b ∣ a) :
+  a / b = c ↔ a = b * c :=
+iff.intro
+  (assume H1, by rewrite [-H1, int.mul_div_cancel' H'])
+  (assume H1, by rewrite [H1, !int.mul_div_cancel_left H])
+
+protected theorem div_eq_iff_eq_mul_left {a b : ℤ} (c : ℤ) (H : b ≠ 0) (H' : b ∣ a) :
+  a / b = c ↔ a = c * b :=
+!mul.comm ▸ !int.div_eq_iff_eq_mul_right H H'
+
+protected theorem eq_mul_of_div_eq_right {a b c : ℤ} (H1 : b ∣ a) (H2 : a / b = c) :
+  a = b * c :=
+calc
+  a     = b * (a / b) : int.mul_div_cancel' H1
+    ... = b * c       : H2
+
+protected theorem div_eq_of_eq_mul_right {a b c : ℤ} (H1 : b ≠ 0) (H2 : a = b * c) :
+  a / b = c :=
+calc
+  a / b = b * c / b : H2
+    ... = c         : !int.mul_div_cancel_left H1
+
+protected theorem eq_mul_of_div_eq_left {a b c : ℤ} (H1 : b ∣ a) (H2 : a / b = c) :
+  a = c * b :=
+!mul.comm ▸ !int.eq_mul_of_div_eq_right H1 H2
+
+protected theorem div_eq_of_eq_mul_left {a b c : ℤ} (H1 : b ≠ 0) (H2 : a = c * b) :
+  a / b = c :=
+int.div_eq_of_eq_mul_right H1 (!mul.comm ▸ H2)
+
+theorem neg_div_of_dvd {a b : ℤ} (H : b ∣ a) : -a / b = -(a / b) :=
+decidable.by_cases
+  (assume H1 : b = 0, by rewrite [H1, *int.div_zero, neg_zero])
+  (assume H1 : b ≠ 0,
+    dvd.elim H
+      (take c, assume H' : a = b * c,
+        by rewrite [H', neg_mul_eq_mul_neg, *!int.mul_div_cancel_left H1]))
+
+protected theorem sign_eq_div_abs (a : ℤ) : sign a = a / (abs a) :=
+decidable.by_cases
+  (suppose a = 0, by subst a)
+  (suppose a ≠ 0,
+    have abs a ≠ 0, from assume H, this (eq_zero_of_abs_eq_zero H),
+    have abs a ∣ a, from abs_dvd_of_dvd !dvd.refl,
+    eq.symm (iff.mpr (!int.div_eq_iff_eq_mul_left `abs a ≠ 0` this) !eq_sign_mul_abs))
+
+theorem le_of_dvd {a b : ℤ} (bpos : b > 0) (H : a ∣ b) : a ≤ b :=
+or.elim !le_or_gt
+  (suppose a ≤ 0, le.trans this (le_of_lt bpos))
+  (suppose a > 0,
+    obtain c (Hc : b = a * c), from exists_eq_mul_right_of_dvd H,
+    have a * c > 0, by rewrite -Hc; exact bpos,
+    have c > 0, from pos_of_mul_pos_left this (le_of_lt `a > 0`),
+    show a ≤ b, from calc
+      a     = a * 1 : mul_one
+        ... ≤ a * c : mul_le_mul_of_nonneg_left (add_one_le_of_lt `c > 0`) (le_of_lt `a > 0`)
+        ... = b     : Hc)
+
+/- / and ordering -/
+
+protected theorem div_mul_le (a : ℤ) {b : ℤ} (H : b ≠ 0) : a / b * b ≤ a :=
+calc
+  a = a / b * b + a % b : eq_div_mul_add_mod
+    ... ≥ a / b * b       : le_add_of_nonneg_right (!mod_nonneg H)
+
+protected theorem div_le_of_le_mul {a b c : ℤ} (H : c > 0) (H' : a ≤ b * c) : a / c ≤ b :=
+le_of_mul_le_mul_right (calc
+  a / c * c = a / c * c + 0     : add_zero
+        ... ≤ a / c * c + a % c : add_le_add_left (!mod_nonneg (ne_of_gt H))
+        ... = a                 : eq_div_mul_add_mod
+        ... ≤ b * c             : H') H
+
+protected theorem div_le_self (a : ℤ) {b : ℤ} (H1 : a ≥ 0) (H2 : b ≥ 0) : a / b ≤ a :=
+or.elim (lt_or_eq_of_le H2)
+  (assume H3 : b > 0,
+    have H4 : b ≥ 1, from add_one_le_of_lt H3,
+    have H5 : a ≤ a * b, from calc
+      a    = a * 1 : mul_one
+       ... ≤ a * b : !mul_le_mul_of_nonneg_left H4 H1,
+    int.div_le_of_le_mul H3 H5)
+  (assume H3 : 0 = b,
+    by rewrite [-H3, int.div_zero]; apply H1)
+
+protected theorem mul_le_of_le_div {a b c : ℤ} (H1 : c > 0) (H2 : a ≤ b / c) : a * c ≤ b :=
+calc
+  a * c ≤ b / c * c : !mul_le_mul_of_nonneg_right H2 (le_of_lt H1)
+    ... ≤ b           : !int.div_mul_le (ne_of_gt H1)
+
+protected theorem le_div_of_mul_le {a b c : ℤ} (H1 : c > 0) (H2 : a * c ≤ b) : a ≤ b / c :=
+have H3 : a * c < (b / c + 1) * c, from
+  calc
+    a * c ≤ b                 : H2
+      ... = b / c * c + b % c : eq_div_mul_add_mod
+      ... < b / c * c + c     : add_lt_add_left (!mod_lt_of_pos H1)
+      ... = (b / c + 1) * c   : by rewrite [right_distrib, one_mul],
+le_of_lt_add_one (lt_of_mul_lt_mul_right H3 (le_of_lt H1))
+
+protected theorem le_div_iff_mul_le {a b c : ℤ} (H : c > 0) : a ≤ b / c ↔ a * c ≤ b :=
+iff.intro (!int.mul_le_of_le_div H) (!int.le_div_of_mul_le H)
+
+protected theorem div_le_div {a b c : ℤ} (H : c > 0) (H' : a ≤ b) : a / c ≤ b / c :=
+int.le_div_of_mul_le H (le.trans (!int.div_mul_le (ne_of_gt H)) H')
+
+protected theorem div_lt_of_lt_mul {a b c : ℤ} (H : c > 0) (H' : a < b * c) : a / c < b :=
+lt_of_mul_lt_mul_right
+  (calc
+    a / c * c = a / c * c + 0       : add_zero
+            ... ≤ a / c * c + a % c : add_le_add_left (!mod_nonneg (ne_of_gt H))
+            ... = a                 : eq_div_mul_add_mod
+            ... < b * c             : H')
+ (le_of_lt H)
+
+protected theorem lt_mul_of_div_lt {a b c : ℤ} (H1 : c > 0) (H2 : a / c < b) : a < b * c :=
+have H3 : (a / c + 1) * c ≤ b * c,
+  from !mul_le_mul_of_nonneg_right (add_one_le_of_lt H2) (le_of_lt H1),
+have H4 : a / c * c + c ≤ b * c, by rewrite [right_distrib at H3, one_mul at H3]; apply H3,
+calc
+  a     = a / c * c + a % c : eq_div_mul_add_mod
+    ... < a / c * c + c     : add_lt_add_left (!mod_lt_of_pos H1)
+    ... ≤ b * c             : H4
+
+protected theorem div_lt_iff_lt_mul {a b c : ℤ} (H : c > 0) : a / c < b ↔ a < b * c :=
+iff.intro (!int.lt_mul_of_div_lt H) (!int.div_lt_of_lt_mul H)
+
+protected theorem div_le_iff_le_mul_of_div {a b : ℤ} (c : ℤ) (H : b > 0) (H' : b ∣ a) :
+  a / b ≤ c ↔ a ≤ c * b :=
+by rewrite [propext (!le_iff_mul_le_mul_right H), !int.div_mul_cancel H']
+
+protected theorem le_mul_of_div_le_of_div {a b c : ℤ} (H1 : b > 0) (H2 : b ∣ a) (H3 : a / b ≤ c) :
+  a ≤ c * b :=
+iff.mp (!int.div_le_iff_le_mul_of_div H1 H2) H3
+
+theorem div_pos_of_pos_of_dvd {a b : ℤ} (H1 : a > 0) (H2 : b ≥ 0) (H3 : b ∣ a) : a / b > 0 :=
+have H4 : b ≠ 0, from
+  (assume H5 : b = 0,
+    have H6 : a = 0, from eq_zero_of_zero_dvd (H5 ▸ H3),
+    ne_of_gt H1 H6),
+have H6 : (a / b) * b > 0, by rewrite (int.div_mul_cancel H3); apply H1,
+pos_of_mul_pos_right H6 H2
+
+theorem div_eq_div_of_dvd_of_dvd {a b c d : ℤ} (H1 : b ∣ a) (H2 : d ∣ c) (H3 : b ≠ 0)
+    (H4 : d ≠ 0) (H5 : a * d = b * c) :
+  a / b = c / d :=
+begin
+  apply int.div_eq_of_eq_mul_right H3,
+  rewrite [-!int.mul_div_assoc H2],
+  apply eq.symm,
+  apply int.div_eq_of_eq_mul_left H4,
+  apply eq.symm H5
+end
+
+end int

old_library/data/int/gcd.lean

@@ -0,0 +1,350 @@
+/-
+Copyright (c) 2014 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad, Leonardo de Moura
+
+Definitions and properties of gcd, lcm, and coprime.
+-/
+import .div data.nat.gcd
+open eq.ops
+
+namespace int
+
+/- gcd -/
+
+definition gcd (a b : ℤ) : ℤ := of_nat (nat.gcd (nat_abs a) (nat_abs b))
+
+theorem gcd_nonneg (a b : ℤ) : gcd a b ≥ 0 :=
+of_nat_nonneg (nat.gcd (nat_abs a) (nat_abs b))
+
+theorem gcd.comm (a b : ℤ) : gcd a b = gcd b a :=
+by rewrite [↑gcd, nat.gcd.comm]
+
+theorem gcd_zero_right (a : ℤ) : gcd a 0 = abs a :=
+by rewrite [↑gcd, nat_abs_zero, nat.gcd_zero_right, of_nat_nat_abs]
+
+theorem gcd_zero_left (a : ℤ) : gcd 0 a = abs a :=
+by rewrite [gcd.comm, gcd_zero_right]
+
+theorem gcd_one_right (a : ℤ) : gcd a 1 = 1 :=
+by rewrite [↑gcd, nat_abs_one, nat.gcd_one_right]
+
+theorem gcd_one_left (a : ℤ) : gcd 1 a = 1 :=
+by rewrite [gcd.comm, gcd_one_right]
+
+theorem gcd_abs_left (a b : ℤ) : gcd (abs a) b = gcd a b :=
+by rewrite [↑gcd, *nat_abs_abs]
+
+theorem gcd_abs_right (a b : ℤ) : gcd (abs a) b = gcd a b :=
+by rewrite [↑gcd, *nat_abs_abs]
+
+theorem gcd_abs_abs (a b : ℤ) : gcd (abs a) (abs b) = gcd a b :=
+by rewrite [↑gcd, *nat_abs_abs]
+
+section
+open nat
+theorem gcd_of_ne_zero (a : ℤ) {b : ℤ} (H : b ≠ 0) : gcd a b = gcd b (abs a % abs b) :=
+have nat_abs b ≠ 0,  from assume H', H (eq_zero_of_nat_abs_eq_zero H'),
+have nat_abs b > 0,  from pos_of_ne_zero this,
+have nat.gcd (nat_abs a) (nat_abs b) = (nat.gcd (nat_abs b) (nat_abs a % nat_abs b)),
+  from @nat.gcd_of_pos (nat_abs a) (nat_abs b) this,
+calc
+ gcd a b = nat.gcd (nat_abs b) (nat_abs a % nat_abs b) : by rewrite [↑gcd, this]
+     ... = gcd (abs b) (abs a % abs b)                 : by rewrite [↑gcd, -*of_nat_nat_abs, of_nat_mod]
+     ... = gcd b (abs a % abs b)                       : by rewrite [↑gcd, *nat_abs_abs]
+end
+
+theorem gcd_of_pos (a : ℤ) {b : ℤ} (H : b > 0) : gcd a b = gcd b (abs a % b) :=
+by rewrite [!gcd_of_ne_zero (ne_of_gt H), abs_of_pos H]
+
+theorem gcd_of_nonneg_of_pos {a b : ℤ} (H1 : a ≥ 0) (H2 : b > 0) : gcd a b = gcd b (a % b) :=
+by rewrite [!gcd_of_pos H2, abs_of_nonneg H1]
+
+theorem gcd_self (a : ℤ) : gcd a a = abs a :=
+by rewrite [↑gcd, nat.gcd_self, of_nat_nat_abs]
+
+theorem gcd_dvd_left (a b : ℤ) : gcd a b ∣ a :=
+have gcd a b ∣ abs a,
+  by rewrite [↑gcd, -of_nat_nat_abs, of_nat_dvd_of_nat_iff]; apply nat.gcd_dvd_left,
+iff.mp !dvd_abs_iff this
+
+theorem gcd_dvd_right (a b : ℤ) : gcd a b ∣ b :=
+by rewrite gcd.comm; apply gcd_dvd_left
+
+theorem dvd_gcd {a b c : ℤ} : a ∣ b → a ∣ c → a ∣ gcd b c :=
+begin
+  rewrite [↑gcd, -*(abs_dvd_iff a), -(dvd_abs_iff _ b), -(dvd_abs_iff _ c), -*of_nat_nat_abs],
+  rewrite [*of_nat_dvd_of_nat_iff] ,
+  apply nat.dvd_gcd
+end
+
+theorem gcd.assoc (a b c : ℤ) : gcd (gcd a b) c = gcd a (gcd b c) :=
+dvd.antisymm !gcd_nonneg !gcd_nonneg
+  (dvd_gcd
+    (dvd.trans !gcd_dvd_left !gcd_dvd_left)
+    (dvd_gcd (dvd.trans !gcd_dvd_left !gcd_dvd_right) !gcd_dvd_right))
+  (dvd_gcd
+    (dvd_gcd !gcd_dvd_left (dvd.trans !gcd_dvd_right !gcd_dvd_left))
+    (dvd.trans !gcd_dvd_right !gcd_dvd_right))
+
+theorem gcd_mul_left (a b c : ℤ) : gcd (a * b) (a * c) = abs a * gcd b c :=
+by rewrite [↑gcd, *nat_abs_mul, nat.gcd_mul_left, of_nat_mul, of_nat_nat_abs]
+
+theorem gcd_mul_right (a b c : ℤ) : gcd (a * b) (c * b) = gcd a c * abs b :=
+by rewrite [mul.comm a, mul.comm c, mul.comm (gcd a c), gcd_mul_left]
+
+theorem gcd_pos_of_ne_zero_left {a : ℤ} (b : ℤ) (H : a ≠ 0) : gcd a b > 0 :=
+have gcd a b ≠ 0, from
+  suppose gcd a b = 0,
+  have 0 ∣ a,    from this ▸ gcd_dvd_left a b,
+  show false,    from H (eq_zero_of_zero_dvd this),
+lt_of_le_of_ne (gcd_nonneg a b) (ne.symm this)
+
+theorem gcd_pos_of_ne_zero_right (a : ℤ) {b : ℤ} (H : b ≠ 0) : gcd a b > 0 :=
+by rewrite gcd.comm; apply !gcd_pos_of_ne_zero_left H
+
+theorem eq_zero_of_gcd_eq_zero_left {a b : ℤ} (H : gcd a b = 0) : a = 0 :=
+decidable.by_contradiction
+  (suppose a ≠ 0,
+    have gcd a b > 0, from !gcd_pos_of_ne_zero_left this,
+    ne_of_lt this H⁻¹)
+
+theorem eq_zero_of_gcd_eq_zero_right {a b : ℤ} (H : gcd a b = 0) : b = 0 :=
+by rewrite gcd.comm at H; apply !eq_zero_of_gcd_eq_zero_left H
+
+theorem gcd_div {a b c : ℤ} (H1 : c ∣ a) (H2 : c ∣ b) :
+  gcd (a / c) (b / c) = gcd a b / (abs c) :=
+decidable.by_cases
+  (suppose c = 0,
+    calc
+      gcd (a / c) (b / c) = gcd 0 0               : by subst c; rewrite *int.div_zero
+                          ... = 0                 : gcd_zero_left
+                          ... = gcd a b / 0       : int.div_zero
+                          ... = gcd a b / (abs c) : by subst c)
+  (suppose c ≠ 0,
+    have abs c ≠ 0, from assume H', this (eq_zero_of_abs_eq_zero H'),
+    eq.symm (int.div_eq_of_eq_mul_left this
+      (eq.symm (calc
+        gcd (a / c) (b / c) * abs c = gcd (a / c * c) (b / c * c) : gcd_mul_right
+                               ... = gcd a (b / c * c)            : int.div_mul_cancel H1
+                               ... = gcd a b                      : int.div_mul_cancel H2))))
+
+theorem gcd_dvd_gcd_mul_left (a b c : ℤ) : gcd a b ∣ gcd (c * a) b :=
+dvd_gcd (dvd.trans !gcd_dvd_left !dvd_mul_left) !gcd_dvd_right
+
+theorem gcd_dvd_gcd_mul_right (a b c : ℤ) : gcd a b ∣ gcd (a * c) b :=
+!mul.comm ▸ !gcd_dvd_gcd_mul_left
+
+theorem div_gcd_eq_div_gcd_of_nonneg {a₁ b₁ a₂ b₂ : ℤ} (H : a₁ * b₂ = a₂ * b₁)
+    (H1 : b₁ ≠ 0) (H2 : b₂ ≠ 0) (H3 : a₁ ≥ 0) (H4 : a₂ ≥ 0) :
+  a₁ / (gcd a₁ b₁) = a₂ / (gcd a₂ b₂) :=
+begin
+  apply div_eq_div_of_dvd_of_dvd,
+  repeat (apply gcd_dvd_left),
+  intro H', apply H1, apply eq_zero_of_gcd_eq_zero_right H',
+  intro H', apply H2, apply eq_zero_of_gcd_eq_zero_right H',
+  rewrite [-abs_of_nonneg H3 at {1}, -abs_of_nonneg H4 at {2}],
+  rewrite [-gcd_mul_left, -gcd_mul_right, H, mul.comm b₁]
+end
+
+theorem div_gcd_eq_div_gcd {a₁ b₁ a₂ b₂ : ℤ} (H : a₁ * b₂ = a₂ * b₁) (H1 : b₁ > 0) (H2 : b₂ > 0) :
+  a₁ / (gcd a₁ b₁) = a₂ / (gcd a₂ b₂) :=
+or.elim (le_or_gt 0 a₁)
+  (assume H3 : a₁ ≥ 0,
+    have H4 : a₂ * b₁ ≥ 0, by rewrite -H; apply mul_nonneg H3 (le_of_lt H2),
+    have H5 : a₂ ≥ 0, from nonneg_of_mul_nonneg_right H4 H1,
+    div_gcd_eq_div_gcd_of_nonneg H (ne_of_gt H1) (ne_of_gt H2) H3 H5)
+  (assume H3 : a₁ < 0,
+    have H4 : a₂ * b₁ < 0, by rewrite -H; apply mul_neg_of_neg_of_pos H3 H2,
+    have H5 : a₂ < 0, from neg_of_mul_neg_right H4 (le_of_lt H1),
+    have H6 : abs a₁ / (gcd (abs a₁) (abs b₁)) = abs a₂ / (gcd (abs a₂) (abs b₂)),
+      begin
+        apply div_gcd_eq_div_gcd_of_nonneg,
+        rewrite [abs_of_pos H1, abs_of_pos H2, abs_of_neg H3, abs_of_neg H5],
+        rewrite [-*neg_mul_eq_neg_mul, H],
+        apply ne_of_gt (abs_pos_of_pos H1),
+        apply ne_of_gt (abs_pos_of_pos H2),
+        repeat (apply abs_nonneg)
+      end,
+    have H7 : -a₁ / (gcd a₁ b₁) = -a₂ / (gcd a₂ b₂),
+      begin
+        rewrite [-abs_of_neg H3, -abs_of_neg H5, -gcd_abs_abs a₁],
+        rewrite [-gcd_abs_abs a₂ b₂],
+        exact H6
+      end,
+    calc
+      a₁ / (gcd a₁ b₁) = -(-a₁ / (gcd a₁ b₁))   :
+                             by rewrite [neg_div_of_dvd !gcd_dvd_left, neg_neg]
+                     ... = -(-a₂ / (gcd a₂ b₂)) : H7
+                     ... = a₂ / (gcd a₂ b₂)     :
+                             by rewrite [neg_div_of_dvd !gcd_dvd_left, neg_neg])
+
+/- lcm -/
+
+definition lcm (a b : ℤ) : ℤ := of_nat (nat.lcm (nat_abs a) (nat_abs b))
+
+theorem lcm_nonneg (a b : ℤ) : lcm a b ≥ 0 :=
+of_nat_nonneg (nat.lcm (nat_abs a) (nat_abs b))
+
+theorem lcm.comm (a b : ℤ) : lcm a b = lcm b a :=
+by rewrite [↑lcm, nat.lcm.comm]
+
+theorem lcm_zero_left (a : ℤ) : lcm 0 a = 0 :=
+by rewrite [↑lcm, nat_abs_zero, nat.lcm_zero_left]
+
+theorem lcm_zero_right (a : ℤ) : lcm a 0 = 0 :=
+!lcm.comm ▸ !lcm_zero_left
+
+theorem lcm_one_left (a : ℤ) : lcm 1 a = abs a :=
+by rewrite [↑lcm, nat_abs_one, nat.lcm_one_left, of_nat_nat_abs]
+
+theorem lcm_one_right (a : ℤ) : lcm a 1 = abs a :=
+!lcm.comm ▸ !lcm_one_left
+
+theorem lcm_abs_left (a b : ℤ) : lcm (abs a) b = lcm a b :=
+by rewrite [↑lcm, *nat_abs_abs]
+
+theorem lcm_abs_right (a b : ℤ) : lcm (abs a) b = lcm a b :=
+by rewrite [↑lcm, *nat_abs_abs]
+
+theorem lcm_abs_abs (a b : ℤ) : lcm (abs a) (abs b) = lcm a b :=
+by rewrite [↑lcm, *nat_abs_abs]
+
+theorem lcm_self (a : ℤ) : lcm a a = abs a :=
+by rewrite [↑lcm, nat.lcm_self, of_nat_nat_abs]
+
+theorem dvd_lcm_left (a b : ℤ) : a ∣ lcm a b :=
+by rewrite [↑lcm, -abs_dvd_iff, -of_nat_nat_abs, of_nat_dvd_of_nat_iff]; apply nat.dvd_lcm_left
+
+theorem dvd_lcm_right (a b : ℤ) : b ∣ lcm a b :=
+!lcm.comm ▸ !dvd_lcm_left
+
+theorem gcd_mul_lcm (a b : ℤ) : gcd a b * lcm a b = abs (a * b) :=
+begin
+  rewrite [↑gcd, ↑lcm, -of_nat_nat_abs, -of_nat_mul, of_nat_eq_of_nat_iff, nat_abs_mul],
+  apply nat.gcd_mul_lcm
+end
+
+theorem lcm_dvd {a b c : ℤ} : a ∣ c → b ∣ c → lcm a b ∣ c :=
+begin
+  rewrite [↑lcm, -(abs_dvd_iff a), -(abs_dvd_iff b), -*(dvd_abs_iff _ c), -*of_nat_nat_abs],
+  rewrite [*of_nat_dvd_of_nat_iff] ,
+  apply nat.lcm_dvd
+end
+
+theorem lcm_assoc (a b c : ℤ) : lcm (lcm a b) c = lcm a (lcm b c) :=
+dvd.antisymm !lcm_nonneg !lcm_nonneg
+  (lcm_dvd
+    (lcm_dvd !dvd_lcm_left (dvd.trans !dvd_lcm_left !dvd_lcm_right))
+    (dvd.trans !dvd_lcm_right !dvd_lcm_right))
+  (lcm_dvd
+    (dvd.trans !dvd_lcm_left !dvd_lcm_left)
+    (lcm_dvd (dvd.trans !dvd_lcm_right !dvd_lcm_left) !dvd_lcm_right))
+
+/- coprime -/
+
+abbreviation coprime (a b : ℤ) : Prop := gcd a b = 1
+
+theorem coprime_swap {a b : ℤ} (H : coprime b a) : coprime a b :=
+!gcd.comm ▸ H
+
+theorem dvd_of_coprime_of_dvd_mul_right {a b c : ℤ} (H1 : coprime c b) (H2 : c ∣ a * b) : c ∣ a :=
+have H3 : gcd (a * c) (a * b) = abs a, from
+  calc
+    gcd (a * c) (a * b) = abs a * gcd c b : gcd_mul_left
+                    ... = abs a * 1       : H1
+                    ... = abs a           : mul_one,
+have H4 : (c ∣ gcd (a * c) (a * b)), from dvd_gcd !dvd_mul_left H2,
+by rewrite [-dvd_abs_iff, -H3]; apply H4
+
+theorem dvd_of_coprime_of_dvd_mul_left {a b c : ℤ} (H1 : coprime c a) (H2 : c ∣ a * b) : c ∣ b :=
+dvd_of_coprime_of_dvd_mul_right H1 (!mul.comm ▸ H2)
+
+theorem gcd_mul_left_cancel_of_coprime {c : ℤ} (a : ℤ) {b : ℤ} (H : coprime c b) :
+   gcd (c * a) b = gcd a b :=
+begin
+  revert H, unfold [coprime, gcd],
+  rewrite [-of_nat_one],
+  rewrite [+of_nat_eq_of_nat_iff, nat_abs_mul],
+  apply nat.gcd_mul_left_cancel_of_coprime,
+end
+
+theorem gcd_mul_right_cancel_of_coprime (a : ℤ) {c b : ℤ} (H : coprime c b) :
+   gcd (a * c) b = gcd a b :=
+!mul.comm ▸ !gcd_mul_left_cancel_of_coprime H
+
+theorem gcd_mul_left_cancel_of_coprime_right {c a : ℤ} (b : ℤ) (H : coprime c a) :
+   gcd a (c * b) = gcd a b :=
+!gcd.comm ▸ !gcd.comm ▸ !gcd_mul_left_cancel_of_coprime H
+
+theorem gcd_mul_right_cancel_of_coprime_right {c a : ℤ} (b : ℤ) (H : coprime c a) :
+   gcd a (b * c) = gcd a b :=
+!gcd.comm ▸ !gcd.comm ▸ !gcd_mul_right_cancel_of_coprime H
+
+theorem coprime_div_gcd_div_gcd {a b : ℤ} (H : gcd a b ≠ 0) :
+  coprime (a / gcd a b) (b / gcd a b) :=
+calc
+  gcd (a / gcd a b) (b / gcd a b)
+         = gcd a b / abs (gcd a b) : gcd_div !gcd_dvd_left !gcd_dvd_right
+     ... = 1                       : by rewrite [abs_of_nonneg !gcd_nonneg, int.div_self H]
+
+theorem not_coprime_of_dvd_of_dvd {m n d : ℤ} (dgt1 : d > 1) (Hm : d ∣ m) (Hn : d ∣ n) :
+  ¬ coprime m n :=
+assume co : coprime m n,
+have d ∣ gcd m n, from dvd_gcd Hm Hn,
+have d ∣ 1, by rewrite [↑coprime at co, co at this]; apply this,
+have d ≤ 1, from le_of_dvd dec_trivial this,
+show false, from not_lt_of_ge `d ≤ 1` `d > 1`
+
+theorem exists_coprime {a b : ℤ} (H : gcd a b ≠ 0) :
+  exists a' b', coprime a' b' ∧ a = a' * gcd a b ∧ b = b' * gcd a b :=
+have H1 : a = (a / gcd a b) * gcd a b, from (int.div_mul_cancel !gcd_dvd_left)⁻¹,
+have H2 : b = (b / gcd a b) * gcd a b, from (int.div_mul_cancel !gcd_dvd_right)⁻¹,
+exists.intro _ (exists.intro _ (and.intro (coprime_div_gcd_div_gcd H) (and.intro H1 H2)))
+
+theorem coprime_mul {a b c : ℤ} (H1 : coprime a c) (H2 : coprime b c) : coprime (a * b) c :=
+calc
+  gcd (a * b) c = gcd b c : !gcd_mul_left_cancel_of_coprime H1
+            ... = 1       : H2
+
+theorem coprime_mul_right {c a b : ℤ} (H1 : coprime c a) (H2 : coprime c b) : coprime c (a * b) :=
+coprime_swap (coprime_mul (coprime_swap H1) (coprime_swap H2))
+
+theorem coprime_of_coprime_mul_left {c a b : ℤ} (H : coprime (c * a) b) : coprime a b :=
+have H1 : (gcd a b ∣ gcd (c * a) b), from !gcd_dvd_gcd_mul_left,
+eq_one_of_dvd_one !gcd_nonneg (H ▸ H1)
+
+theorem coprime_of_coprime_mul_right {c a b : ℤ} (H : coprime (a * c) b) : coprime a b :=
+coprime_of_coprime_mul_left (!mul.comm ▸ H)
+
+theorem coprime_of_coprime_mul_left_right {c a b : ℤ} (H : coprime a (c * b)) : coprime a b :=
+coprime_swap (coprime_of_coprime_mul_left (coprime_swap H))
+
+theorem coprime_of_coprime_mul_right_right {c a b : ℤ} (H : coprime a (b * c)) : coprime a b :=
+coprime_of_coprime_mul_left_right (!mul.comm ▸ H)
+
+theorem exists_eq_prod_and_dvd_and_dvd {a b c : ℤ} (H : c ∣ a * b) :
+  ∃ a' b', c = a' * b' ∧ a' ∣ a ∧ b' ∣ b :=
+decidable.by_cases
+ (suppose gcd c a = 0,
+    have c = 0, from eq_zero_of_gcd_eq_zero_left `gcd c a = 0`,
+    have a = 0, from eq_zero_of_gcd_eq_zero_right `gcd c a = 0`,
+    have c = 0 * b, from `c = 0` ⬝ !zero_mul⁻¹,
+    have 0 ∣ a, from `a = 0`⁻¹ ▸ !dvd.refl,
+    have b ∣ b, from !dvd.refl,
+    exists.intro _ (exists.intro _ (and.intro `c = 0 * b` (and.intro `0 ∣ a` `b ∣ b`))))
+  (suppose gcd c a ≠ 0,
+    have gcd c a ∣ c, from !gcd_dvd_left,
+    have H3 : c / gcd c a ∣ (a * b) / gcd c a, from div_dvd_div this H,
+    have H4 : (a * b) / gcd c a = (a / gcd c a) * b, from
+      calc
+        a * b / gcd c a = b * a / gcd c a     : mul.comm
+                      ... = b * (a / gcd c a) : !int.mul_div_assoc !gcd_dvd_right
+                      ... = a / gcd c a * b   : mul.comm,
+    have H5 : c / gcd c a ∣ (a / gcd c a) * b, from H4 ▸ H3,
+    have H6 : coprime (c / gcd c a) (a / gcd c a), from coprime_div_gcd_div_gcd `gcd c a ≠ 0`,
+    have H7 : c / gcd c a ∣ b, from dvd_of_coprime_of_dvd_mul_left H6 H5,
+    have H8 : c = gcd c a * (c / gcd c a), from (int.mul_div_cancel' `gcd c a ∣ c`)⁻¹,
+    exists.intro _ (exists.intro _ (and.intro H8 (and.intro !gcd_dvd_right H7))))
+
+end int

old_library/data/int/int.md

@@ -0,0 +1,10 @@
+data.int
+========
+
+The integers.
+
+* [basic](basic.lean) : the integers, with basic operations
+* [order](order.lean) : the order relations and the sign function
+* [div](div.lean) : div and mod
+* [power](power.lean) 
+* [gcd](gcd.lean) : gcd, lcm, and coprime    

old_library/data/int/order.lean

@@ -0,0 +1,447 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn, Jeremy Avigad
+
+The order relation on the integers. We show that int is an instance of linear_comm_ordered_ring
+and transfer the results.
+-/
+import .basic algebra.ordered_ring
+open nat
+open decidable
+open int eq.ops
+
+namespace int
+
+private definition nonneg (a : ℤ) : Prop := int.cases_on a (take n, true) (take n, false)
+protected definition le (a b : ℤ) : Prop := nonneg (b - a)
+
+attribute [instance, priority int.prio]
+definition int_has_le : has_le int :=
+has_le.mk int.le
+
+protected definition lt (a b : ℤ) : Prop := (a + 1) ≤ b
+
+attribute [instance, priority int.prio]
+definition int_has_lt : has_lt int :=
+has_lt.mk int.lt
+
+local attribute nonneg [reducible]
+attribute [instance]
+private definition decidable_nonneg (a : ℤ) : decidable (nonneg a) := int.cases_on a _ _
+attribute [instance]
+definition decidable_le (a b : ℤ) : decidable (a ≤ b) := decidable_nonneg _
+attribute [instance]
+definition decidable_lt (a b : ℤ) : decidable (a < b) := decidable_nonneg _
+
+private theorem nonneg.elim {a : ℤ} : nonneg a → ∃n : ℕ, a = n :=
+int.cases_on a (take n H, exists.intro n rfl) (take n', false.elim)
+
+private theorem nonneg_or_nonneg_neg (a : ℤ) : nonneg a ∨ nonneg (-a) :=
+int.cases_on a (take n, or.inl trivial) (take n, or.inr trivial)
+
+theorem le.intro {a b : ℤ} {n : ℕ} (H : a + n = b) : a ≤ b :=
+have n = b - a, from eq_add_neg_of_add_eq (begin rewrite [add.comm, H] end), -- !add.comm ▸ H),
+show nonneg (b - a), from this ▸ trivial
+
+theorem le.elim {a b : ℤ} (H : a ≤ b) : ∃n : ℕ, a + n = b :=
+obtain (n : ℕ) (H1 : b - a = n), from nonneg.elim H,
+exists.intro n (!add.comm ▸ iff.mpr !add_eq_iff_eq_add_neg (H1⁻¹))
+
+protected theorem le_total (a b : ℤ) : a ≤ b ∨ b ≤ a :=
+or.imp_right
+  (assume H : nonneg (-(b - a)),
+   have -(b - a) = a - b, from !neg_sub,
+   show nonneg (a - b), from this ▸ H)
+  (nonneg_or_nonneg_neg (b - a))
+
+theorem of_nat_le_of_nat_of_le {m n : ℕ} (H : #nat m ≤ n) : of_nat m ≤ of_nat n :=
+obtain (k : ℕ) (Hk : m + k = n), from nat.le.elim H,
+le.intro (Hk ▸ (of_nat_add m k)⁻¹)
+
+theorem le_of_of_nat_le_of_nat {m n : ℕ} (H : of_nat m ≤ of_nat n) : (#nat m ≤ n) :=
+obtain (k : ℕ) (Hk : of_nat m + of_nat k = of_nat n), from le.elim H,
+have m + k = n, from of_nat.inj (of_nat_add m k ⬝ Hk),
+nat.le.intro this
+
+theorem of_nat_le_of_nat_iff (m n : ℕ) : of_nat m ≤ of_nat n ↔ m ≤ n :=
+iff.intro le_of_of_nat_le_of_nat of_nat_le_of_nat_of_le
+
+theorem lt_add_succ (a : ℤ) (n : ℕ) : a < a + succ n :=
+le.intro (show a + 1 + n = a + succ n, from
+  calc
+    a + 1 + n = a + (1 + n) : add.assoc
+      ... = a + (n + 1)     : by rewrite (int.add_comm 1 n)
+      ... = a + succ n      : rfl)
+
+theorem lt.intro {a b : ℤ} {n : ℕ} (H : a + succ n = b) : a < b :=
+H ▸ lt_add_succ a n
+
+theorem lt.elim {a b : ℤ} (H : a < b) : ∃n : ℕ, a + succ n = b :=
+obtain (n : ℕ) (Hn : a + 1 + n = b), from le.elim H,
+have a + succ n = b, from
+  calc
+    a + succ n = a + 1 + n : by rewrite [add.assoc, int.add_comm 1 n]
+           ... = b         : Hn,
+exists.intro n this
+
+theorem of_nat_lt_of_nat_iff (n m : ℕ) : of_nat n < of_nat m ↔ n < m :=
+calc
+  of_nat n < of_nat m ↔ of_nat n + 1 ≤ of_nat m : iff.refl
+    ... ↔ of_nat (nat.succ n) ≤ of_nat m        : of_nat_succ n ▸ !iff.refl
+    ... ↔ nat.succ n ≤ m                        : of_nat_le_of_nat_iff
+    ... ↔ n < m                                 : iff.symm (lt_iff_succ_le _ _)
+
+theorem lt_of_of_nat_lt_of_nat {m n : ℕ} (H : of_nat m < of_nat n) : #nat m < n :=
+iff.mp !of_nat_lt_of_nat_iff H
+
+theorem of_nat_lt_of_nat_of_lt {m n : ℕ} (H : #nat m < n) : of_nat m < of_nat n :=
+iff.mpr !of_nat_lt_of_nat_iff H
+
+/- show that the integers form an ordered additive group -/
+
+protected theorem le_refl (a : ℤ) : a ≤ a :=
+le.intro (add_zero a)
+
+protected theorem le_trans {a b c : ℤ} (H1 : a ≤ b) (H2 : b ≤ c) : a ≤ c :=
+obtain (n : ℕ) (Hn : a + n = b), from le.elim H1,
+obtain (m : ℕ) (Hm : b + m = c), from le.elim H2,
+have a + of_nat (n + m) = c, from
+  calc
+    a + of_nat (n + m) = a + (of_nat n + m) : {of_nat_add n m}
+      ... = a + n + m : (add.assoc a n m)⁻¹
+      ... = b + m : {Hn}
+      ... = c : Hm,
+le.intro this
+
+protected theorem le_antisymm : ∀ {a b : ℤ}, a ≤ b → b ≤ a → a = b :=
+take a b : ℤ, assume (H₁ : a ≤ b) (H₂ : b ≤ a),
+obtain (n : ℕ) (Hn : a + n = b), from le.elim H₁,
+obtain (m : ℕ) (Hm : b + m = a), from le.elim H₂,
+have a + of_nat (n + m) = a + 0, from
+  calc
+    a + of_nat (n + m) = a + (of_nat n + m) : by rewrite of_nat_add
+      ... = a + n + m                       : by rewrite add.assoc
+      ... = b + m                           : by rewrite Hn
+      ... = a                               : by rewrite Hm
+      ... = a + 0                           : by rewrite add_zero,
+have of_nat (n + m) = of_nat 0, from add.left_cancel this,
+have n + m = 0,                 from of_nat.inj this,
+have n = 0,                     from nat.eq_zero_of_add_eq_zero_right this,
+show a = b, from
+  calc
+    a = a + 0    : add_zero
+  ... = a + n    : by rewrite this
+  ... = b        : Hn
+
+protected theorem lt_irrefl (a : ℤ) : ¬ a < a :=
+(suppose a < a,
+  obtain (n : ℕ) (Hn : a + succ n = a), from lt.elim this,
+  have a + succ n = a + 0, from
+    Hn ⬝ !add_zero⁻¹,
+  !succ_ne_zero (of_nat.inj (add.left_cancel this)))
+
+protected theorem ne_of_lt {a b : ℤ} (H : a < b) : a ≠ b :=
+(suppose a = b, absurd (this ▸ H) (int.lt_irrefl b))
+
+theorem le_of_lt {a b : ℤ} (H : a < b) : a ≤ b :=
+obtain (n : ℕ) (Hn : a + succ n = b), from lt.elim H,
+le.intro Hn
+
+protected theorem lt_iff_le_and_ne (a b : ℤ) : a < b ↔ (a ≤ b ∧ a ≠ b) :=
+iff.intro
+  (assume H, and.intro (le_of_lt H) (int.ne_of_lt H))
+  (assume H,
+    have a ≤ b, from and.elim_left H,
+    have a ≠ b, from and.elim_right H,
+    obtain (n : ℕ) (Hn : a + n = b), from le.elim `a ≤ b`,
+    have n ≠ 0, from (assume H' : n = 0, `a ≠ b` (!add_zero ▸ H' ▸ Hn)),
+    obtain (k : ℕ) (Hk : n = nat.succ k), from nat.exists_eq_succ_of_ne_zero this,
+    lt.intro (Hk ▸ Hn))
+
+protected theorem le_iff_lt_or_eq (a b : ℤ) : a ≤ b ↔ (a < b ∨ a = b) :=
+iff.intro
+  (assume H,
+    by_cases
+      (suppose a = b, or.inr this)
+      (suppose a ≠ b,
+        obtain (n : ℕ) (Hn : a + n = b), from le.elim H,
+        have n ≠ 0, from (assume H' : n = 0, `a ≠ b` (!add_zero ▸ H' ▸ Hn)),
+        obtain (k : ℕ) (Hk : n = nat.succ k), from nat.exists_eq_succ_of_ne_zero this,
+        or.inl (lt.intro (Hk ▸ Hn))))
+  (assume H,
+    or.elim H
+      (assume H1, le_of_lt H1)
+      (assume H1, H1 ▸ !int.le_refl))
+
+theorem lt_succ (a : ℤ) : a < a + 1 :=
+int.le_refl (a + 1)
+
+protected theorem add_le_add_left {a b : ℤ} (H : a ≤ b) (c : ℤ) : c + a ≤ c + b :=
+obtain (n : ℕ) (Hn : a + n = b), from le.elim H,
+have H2 : c + a + n = c + b, from
+  calc
+    c + a + n = c + (a + n) : add.assoc c a n
+      ... = c + b : {Hn},
+le.intro H2
+
+protected theorem add_lt_add_left {a b : ℤ} (H : a < b) (c : ℤ) : c + a < c + b :=
+let H' := le_of_lt H in
+(iff.mpr (int.lt_iff_le_and_ne _ _)) (and.intro (int.add_le_add_left H' _)
+                                  (take Heq, let Heq' := add_left_cancel Heq in
+                                   !int.lt_irrefl (Heq' ▸ H)))
+
+protected theorem mul_nonneg {a b : ℤ} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a * b :=
+obtain (n : ℕ) (Hn : 0 + n = a), from le.elim Ha,
+obtain (m : ℕ) (Hm : 0 + m = b), from le.elim Hb,
+le.intro
+  (eq.symm
+    (calc
+      a * b = (0 + n) * b : by rewrite Hn
+        ... = n * b       : by rewrite zero_add
+        ... = n * (0 + m) : by rewrite Hm
+        ... = n * m       : by rewrite zero_add
+        ... = 0 + n * m   : by rewrite zero_add))
+
+protected theorem mul_pos {a b : ℤ} (Ha : 0 < a) (Hb : 0 < b) : 0 < a * b :=
+obtain (n : ℕ) (Hn : 0 + nat.succ n = a), from lt.elim Ha,
+obtain (m : ℕ) (Hm : 0 + nat.succ m = b), from lt.elim Hb,
+lt.intro
+  (eq.symm
+    (calc
+      a * b = (0 + nat.succ n) * b                     : by rewrite Hn
+        ... = nat.succ n * b                           : by rewrite zero_add
+        ... = nat.succ n * (0 + nat.succ m)            : by rewrite Hm
+        ... = nat.succ n * nat.succ m                  : by rewrite zero_add
+        ... = of_nat (nat.succ n * nat.succ m)         : by rewrite of_nat_mul
+        ... = of_nat (nat.succ n * m + nat.succ n)     : by rewrite nat.mul_succ
+        ... = of_nat (nat.succ (nat.succ n * m + n))   : by rewrite nat.add_succ
+        ... = 0 + nat.succ (nat.succ n * m + n)        : by rewrite zero_add))
+
+protected theorem zero_lt_one : (0 : ℤ) < 1 := trivial
+
+protected theorem not_le_of_gt {a b : ℤ} (H : a < b) : ¬ b ≤ a :=
+  assume Hba,
+  let Heq := int.le_antisymm (le_of_lt H) Hba in
+  !int.lt_irrefl (Heq ▸ H)
+
+protected theorem lt_of_lt_of_le {a b c : ℤ} (Hab : a < b) (Hbc : b ≤ c) : a < c :=
+  let Hab' := le_of_lt Hab in
+  let Hac := int.le_trans Hab' Hbc in
+  (iff.mpr !int.lt_iff_le_and_ne) (and.intro Hac
+    (assume Heq, int.not_le_of_gt (Heq ▸ Hab) Hbc))
+
+protected theorem lt_of_le_of_lt  {a b c : ℤ} (Hab : a ≤ b) (Hbc : b < c) : a < c :=
+  let Hbc' := le_of_lt Hbc in
+  let Hac := int.le_trans Hab Hbc' in
+  (iff.mpr !int.lt_iff_le_and_ne) (and.intro Hac
+    (assume Heq, int.not_le_of_gt (Heq⁻¹ ▸ Hbc) Hab))
+
+attribute [trans_instance]
+protected definition linear_ordered_comm_ring :
+    linear_ordered_comm_ring int :=
+⦃linear_ordered_comm_ring, int.integral_domain,
+  le               := int.le,
+  le_refl          := int.le_refl,
+  le_trans         := @int.le_trans,
+  le_antisymm      := @int.le_antisymm,
+  lt               := int.lt,
+  le_of_lt         := @int.le_of_lt,
+  lt_irrefl        := int.lt_irrefl,
+  lt_of_lt_of_le   := @int.lt_of_lt_of_le,
+  lt_of_le_of_lt   := @int.lt_of_le_of_lt,
+  add_le_add_left  := @int.add_le_add_left,
+  mul_nonneg       := @int.mul_nonneg,
+  mul_pos          := @int.mul_pos,
+  le_iff_lt_or_eq  := int.le_iff_lt_or_eq,
+  le_total         := int.le_total,
+  zero_ne_one      := int.zero_ne_one,
+  zero_lt_one      := int.zero_lt_one,
+  add_lt_add_left  := @int.add_lt_add_left⦄
+
+attribute [instance]
+protected definition decidable_linear_ordered_comm_ring :
+    decidable_linear_ordered_comm_ring int :=
+⦃decidable_linear_ordered_comm_ring,
+ int.linear_ordered_comm_ring,
+ decidable_lt := decidable_lt⦄
+
+/- more facts specific to int -/
+
+theorem of_nat_nonneg (n : ℕ) : 0 ≤ of_nat n := trivial
+
+theorem of_nat_pos {n : ℕ} (Hpos : #nat n > 0) : of_nat n > 0 :=
+of_nat_lt_of_nat_of_lt Hpos
+
+theorem of_nat_succ_pos (n : nat) : of_nat (nat.succ n) > 0 :=
+of_nat_pos !nat.succ_pos
+
+theorem exists_eq_of_nat {a : ℤ} (H : 0 ≤ a) : ∃n : ℕ, a = of_nat n :=
+obtain (n : ℕ) (H1 : 0 + of_nat n = a), from le.elim H,
+exists.intro n (!zero_add ▸ (H1⁻¹))
+
+theorem exists_eq_neg_of_nat {a : ℤ} (H : a ≤ 0) : ∃n : ℕ, a = -(of_nat n) :=
+have -a ≥ 0, from iff.mpr !neg_nonneg_iff_nonpos H,
+obtain (n : ℕ) (Hn : -a = of_nat n), from exists_eq_of_nat this,
+exists.intro n (eq_neg_of_eq_neg (Hn⁻¹))
+
+theorem of_nat_nat_abs_of_nonneg {a : ℤ} (H : a ≥ 0) : of_nat (nat_abs a) = a :=
+obtain (n : ℕ) (Hn : a = of_nat n), from exists_eq_of_nat H,
+Hn⁻¹ ▸ congr_arg of_nat (nat_abs_of_nat n)
+
+theorem of_nat_nat_abs_of_nonpos {a : ℤ} (H : a ≤ 0) : of_nat (nat_abs a) = -a :=
+have -a ≥ 0, from iff.mpr !neg_nonneg_iff_nonpos H,
+calc
+  of_nat (nat_abs a) = of_nat (nat_abs (-a)) : nat_abs_neg
+                 ... = -a                    : of_nat_nat_abs_of_nonneg this
+
+theorem of_nat_nat_abs (b : ℤ) : nat_abs b = abs b :=
+or.elim (le.total 0 b)
+  (assume H : b ≥ 0, of_nat_nat_abs_of_nonneg H ⬝ (abs_of_nonneg H)⁻¹)
+  (assume H : b ≤ 0, of_nat_nat_abs_of_nonpos H ⬝ (abs_of_nonpos H)⁻¹)
+
+theorem nat_abs_abs (a : ℤ) : nat_abs (abs a) = nat_abs a :=
+abs.by_cases rfl !nat_abs_neg
+
+theorem lt_of_add_one_le {a b : ℤ} (H : a + 1 ≤ b) : a < b :=
+obtain (n : nat) (H1 : a + 1 + n = b), from le.elim H,
+have a + succ n = b, by rewrite [-H1, add.assoc, add.comm 1],
+lt.intro this
+
+theorem add_one_le_of_lt {a b : ℤ} (H : a < b) : a + 1 ≤ b :=
+obtain (n : nat) (H1 : a + succ n = b), from lt.elim H,
+have a + 1 + n = b, by rewrite [-H1, add.assoc, add.comm 1],
+le.intro this
+
+theorem lt_add_one_of_le {a b : ℤ} (H : a ≤ b) : a < b + 1 :=
+lt_add_of_le_of_pos H trivial
+
+theorem le_of_lt_add_one {a b : ℤ} (H : a < b + 1) : a ≤ b :=
+have H1 : a + 1 ≤ b + 1, from add_one_le_of_lt H,
+le_of_add_le_add_right H1
+
+theorem sub_one_le_of_lt {a b : ℤ} (H : a ≤ b) : a - 1 < b :=
+lt_of_add_one_le (begin rewrite sub_add_cancel, exact H end)
+
+theorem lt_of_sub_one_le {a b : ℤ} (H : a - 1 < b) : a ≤ b :=
+!sub_add_cancel ▸ add_one_le_of_lt H
+
+theorem le_sub_one_of_lt {a b : ℤ} (H : a < b) : a ≤ b - 1 :=
+le_of_lt_add_one begin rewrite sub_add_cancel, exact H end
+
+theorem lt_of_le_sub_one {a b : ℤ} (H : a ≤ b - 1) : a < b :=
+!sub_add_cancel ▸ (lt_add_one_of_le H)
+
+theorem sign_of_succ (n : nat) : sign (nat.succ n) = 1 :=
+sign_of_pos (of_nat_pos !nat.succ_pos)
+
+theorem exists_eq_neg_succ_of_nat {a : ℤ} : a < 0 → ∃m : ℕ, a = -[1+m] :=
+int.cases_on a
+  (take (m : nat) H, absurd (of_nat_nonneg m : 0 ≤ m) (not_le_of_gt H))
+  (take (m : nat) H, exists.intro m rfl)
+
+theorem eq_one_of_mul_eq_one_right {a b : ℤ} (H : a ≥ 0) (H' : a * b = 1) : a = 1 :=
+have a * b > 0, by rewrite H'; apply trivial,
+have b > 0, from pos_of_mul_pos_left this H,
+have a > 0, from pos_of_mul_pos_right `a * b > 0` (le_of_lt `b > 0`),
+or.elim (le_or_gt a 1)
+  (suppose a ≤ 1,
+    show a = 1, from le.antisymm this (add_one_le_of_lt `a > 0`))
+  (suppose a > 1,
+    have a * b ≥ 2 * 1,
+      from mul_le_mul (add_one_le_of_lt `a > 1`) (add_one_le_of_lt `b > 0`) trivial H,
+    have false, by rewrite [H' at this]; exact this,
+    false.elim this)
+
+theorem eq_one_of_mul_eq_one_left {a b : ℤ} (H : b ≥ 0) (H' : a * b = 1) : b = 1 :=
+eq_one_of_mul_eq_one_right H (!mul.comm ▸ H')
+
+theorem eq_one_of_mul_eq_self_left {a b : ℤ} (Hpos : a ≠ 0) (H : b * a = a) : b = 1 :=
+eq_of_mul_eq_mul_right Hpos (H ⬝ (one_mul a)⁻¹)
+
+theorem eq_one_of_mul_eq_self_right {a b : ℤ} (Hpos : b ≠ 0) (H : b * a = b) : a = 1 :=
+eq_one_of_mul_eq_self_left Hpos (!mul.comm ▸ H)
+
+theorem eq_one_of_dvd_one {a : ℤ} (H : a ≥ 0) (H' : a ∣ 1) : a = 1 :=
+dvd.elim H'
+  (take b,
+    suppose 1 = a * b,
+    eq_one_of_mul_eq_one_right H this⁻¹)
+
+theorem exists_least_of_bdd {P : ℤ → Prop} [HP : decidable_pred P]
+    (Hbdd : ∃ b : ℤ, ∀ z : ℤ, z ≤ b → ¬ P z)
+        (Hinh : ∃ z : ℤ, P z) : ∃ lb : ℤ, P lb ∧ (∀ z : ℤ, z < lb → ¬ P z) :=
+  begin
+    cases Hbdd with [b, Hb],
+    cases Hinh with [elt, Helt],
+    existsi b + of_nat (least (λ n, P (b + of_nat n)) (nat.succ (nat_abs (elt - b)))),
+    have Heltb : elt > b, begin
+      apply lt_of_not_ge,
+      intro Hge,
+      apply (Hb _ Hge) Helt
+    end,
+    have H' : P (b + of_nat (nat_abs (elt - b))), begin
+      rewrite [of_nat_nat_abs_of_nonneg (int.le_of_lt (iff.mpr !sub_pos_iff_lt Heltb)),
+              add.comm, sub_add_cancel],
+      apply Helt
+    end,
+    apply and.intro,
+    apply least_of_lt _ !lt_succ_self H',
+    intros z Hz,
+    cases em (z ≤ b) with [Hzb, Hzb],
+    apply Hb _ Hzb,
+    let Hzb' := lt_of_not_ge Hzb,
+    let Hpos := iff.mpr !sub_pos_iff_lt Hzb',
+    have Hzbk : z = b + of_nat (nat_abs (z - b)),
+      by rewrite [of_nat_nat_abs_of_nonneg (int.le_of_lt Hpos), int.add_comm, sub_add_cancel],
+    have Hk : nat_abs (z - b) < least (λ n, P (b + of_nat n)) (nat.succ (nat_abs (elt - b))), begin
+     note Hz' := iff.mp !lt_add_iff_sub_lt_left Hz,
+     rewrite [-of_nat_nat_abs_of_nonneg (int.le_of_lt Hpos) at Hz'],
+     apply lt_of_of_nat_lt_of_nat Hz'
+    end,
+    let Hk' := not_le_of_gt Hk,
+    rewrite Hzbk,
+    apply λ p, mt (ge_least_of_lt _ p) Hk',
+    apply nat.lt_trans Hk,
+    apply least_lt _ !lt_succ_self H'
+  end
+
+theorem exists_greatest_of_bdd {P : ℤ → Prop} [HP : decidable_pred P]
+    (Hbdd : ∃ b : ℤ, ∀ z : ℤ, z ≥ b → ¬ P z)
+        (Hinh : ∃ z : ℤ, P z) : ∃ ub : ℤ, P ub ∧ (∀ z : ℤ, z > ub → ¬ P z) :=
+  begin
+    cases Hbdd with [b, Hb],
+    cases Hinh with [elt, Helt],
+    existsi b - of_nat (least (λ n, P (b - of_nat n)) (nat.succ (nat_abs (b - elt)))),
+    have Heltb : elt < b, begin
+      apply lt_of_not_ge,
+      intro Hge,
+      apply (Hb _ Hge) Helt
+    end,
+    have H' : P (b - of_nat (nat_abs (b - elt))), begin
+      rewrite [of_nat_nat_abs_of_nonneg (int.le_of_lt (iff.mpr !sub_pos_iff_lt Heltb)),
+              sub_sub_self],
+      apply Helt
+    end,
+    apply and.intro,
+    apply least_of_lt _ !lt_succ_self H',
+    intros z Hz,
+    cases em (z ≥ b) with [Hzb, Hzb],
+    apply Hb _ Hzb,
+    let Hzb' := lt_of_not_ge Hzb,
+    let Hpos := iff.mpr !sub_pos_iff_lt Hzb',
+    have Hzbk : z = b - of_nat (nat_abs (b - z)),
+      by rewrite [of_nat_nat_abs_of_nonneg (int.le_of_lt Hpos), sub_sub_self],
+    have Hk : nat_abs (b - z) < least (λ n, P (b - of_nat n)) (nat.succ (nat_abs (b - elt))), begin
+      note Hz' := iff.mp !lt_add_iff_sub_lt_left (iff.mpr !lt_add_iff_sub_lt_right Hz),
+      rewrite [-of_nat_nat_abs_of_nonneg (int.le_of_lt Hpos) at Hz'],
+      apply lt_of_of_nat_lt_of_nat Hz'
+    end,
+    let Hk' := not_le_of_gt Hk,
+    rewrite Hzbk,
+    apply λ p, mt (ge_least_of_lt _ p) Hk',
+    apply nat.lt_trans Hk,
+    apply least_lt _ !lt_succ_self H'
+  end
+
+end int

old_library/data/int/power.lean

@@ -0,0 +1,30 @@
+/-
+Copyright (c) 2015 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+
+The power function on the integers.
+-/
+import data.int.basic data.int.order data.int.div algebra.group_power data.nat.power
+
+namespace int
+
+attribute [instance, priority int.prio]
+definition int_has_pow_nat : has_pow_nat int :=
+has_pow_nat.mk has_pow_nat.pow_nat
+
+/-
+  definition nmul (n : ℕ) (a : ℤ) : ℤ := algebra.nmul n a
+  infix [priority int.prio] ⬝ := nmul
+  definition imul (i : ℤ) (a : ℤ) : ℤ := algebra.imul i a
+-/
+
+open nat
+theorem of_nat_pow (a n : ℕ) : of_nat (a^n) = (of_nat a)^n :=
+begin
+  induction n with n ih,
+    apply eq.refl,
+  krewrite [pow_succ, pow_succ, of_nat_mul, ih]
+end
+
+end int

old_library/data/list/as_type.lean

@@ -0,0 +1,18 @@
+/-
+Copyright (c) 2015 Leonardo de Moura. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+import data.list.basic
+
+namespace list
+structure as_type {A : Type} (l : list A) : Type :=
+(value : A) (is_member : value ∈ l)
+
+namespace as_type
+notation `⟪`:max l `⟫`:0 := as_type l
+
+definition lval {A : Type} (a : A) {l : list A} (m : a ∈ l) : ⟪l⟫ :=
+mk a m
+end as_type
+end list

old_library/data/list/basic.lean

@@ -0,0 +1,775 @@
+/-
+Copyright (c) 2014 Parikshit Khanna. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn
+
+Basic properties of lists.
+-/
+import logic data.nat.order data.nat.sub
+open nat function tactic
+
+namespace list
+variable {T : Type}
+
+attribute [simp]
+lemma cons_ne_nil (a : T) (l : list T) : a::l ≠ [] :=
+sorry -- by contradiction
+
+lemma head_eq_of_cons_eq {A : Type} {h₁ h₂ : A} {t₁ t₂ : list A} :
+      (h₁::t₁) = (h₂::t₂) → h₁ = h₂ :=
+assume Peq, list.no_confusion Peq (assume Pheq Pteq, Pheq)
+
+lemma tail_eq_of_cons_eq {A : Type} {h₁ h₂ : A} {t₁ t₂ : list A} :
+      (h₁::t₁) = (h₂::t₂) → t₁ = t₂ :=
+assume Peq, list.no_confusion Peq (assume Pheq Pteq, Pteq)
+
+lemma cons_inj {A : Type} {a : A} : injective (cons a) :=
+take l₁ l₂, assume Pe, tail_eq_of_cons_eq Pe
+
+/- append -/
+
+attribute [simp]
+theorem append_nil_left (t : list T) : [] ++ t = t :=
+rfl
+
+attribute [simp]
+theorem append_cons (x : T) (s t : list T) : (x::s) ++ t = x::(s ++ t) :=
+rfl
+
+attribute [simp]
+theorem append_nil_right : ∀ (t : list T), t ++ [] = t :=
+sorry -- by rec_inst_simp
+
+attribute [simp]
+theorem append.assoc : ∀ (s t u : list T), s ++ t ++ u = s ++ (t ++ u) :=
+sorry -- by rec_inst_simp
+
+/- length -/
+attribute [simp]
+theorem length_nil : length (@nil T) = 0 :=
+rfl
+
+attribute [simp]
+theorem length_cons (x : T) (t : list T) : length (x::t) = length t + 1 :=
+rfl
+
+attribute [simp]
+theorem length_append : ∀ (s t : list T), length (s ++ t) = length s + length t :=
+sorry -- by rec_inst_simp
+
+theorem eq_nil_of_length_eq_zero : ∀ {l : list T}, length l = 0 → l = []
+| []     H := rfl
+| (a::s) H := sorry -- by contradiction
+
+theorem ne_nil_of_length_eq_succ : ∀ {l : list T} {n : nat}, length l = succ n → l ≠ []
+| []     n h := sorry -- by contradiction
+| (a::l) n h := sorry -- by contradiction
+
+/- concat -/
+
+attribute [simp]
+theorem concat_nil (x : T) : concat x [] = [x] :=
+rfl
+
+attribute [simp]
+theorem concat_cons (x y : T) (l : list T) : concat x (y::l)  = y::(concat x l) :=
+rfl
+
+attribute [simp]
+theorem concat_eq_append (a : T) : ∀ (l : list T), concat a l = l ++ [a] :=
+sorry -- by rec_inst_simp
+
+attribute [simp]
+theorem concat_ne_nil (a : T) : ∀ (l : list T), concat a l ≠ [] :=
+sorry -- by intro l; induction l; repeat contradiction
+
+attribute [simp]
+theorem length_concat (a : T) : ∀ (l : list T), length (concat a l) = length l + 1 :=
+sorry -- by rec_inst_simp
+
+attribute [simp]
+theorem concat_append (a : T) : ∀ (l₁ l₂ : list T), concat a l₁ ++ l₂ = l₁ ++ a :: l₂ :=
+sorry -- by rec_inst_simp
+
+theorem append_concat (a : T)  : ∀(l₁ l₂ : list T), l₁ ++ concat a l₂ = concat a (l₁ ++ l₂) :=
+sorry -- by rec_inst_simp
+
+/- last -/
+
+definition last : Π l : list T, l ≠ [] → T
+| []          h := absurd rfl h
+| [a]         h := a
+| (a₁::a₂::l) h := last (a₂::l) $ cons_ne_nil a₂ l
+
+attribute [simp]
+lemma last_singleton (a : T) (h : [a] ≠ []) : last [a] h = a :=
+rfl
+
+attribute [simp]
+lemma last_cons_cons (a₁ a₂ : T) (l : list T) (h : a₁::a₂::l ≠ []) : last (a₁::a₂::l) h = last (a₂::l) (cons_ne_nil a₂ l) :=
+rfl
+
+theorem last_congr {l₁ l₂ : list T} (h₁ : l₁ ≠ []) (h₂ : l₂ ≠ []) (h₃ : l₁ = l₂) : last l₁ h₁ = last l₂ h₂ :=
+sorry -- by subst l₁
+
+attribute [simp]
+theorem last_concat {x : T} : ∀ {l : list T} (h : concat x l ≠ []), last (concat x l) h = x :=
+sorry -- by rec_simp
+
+-- add_rewrite append_nil append_cons
+
+/- reverse -/
+
+attribute [simp]
+theorem reverse_nil : reverse (@nil T) = [] :=
+rfl
+
+attribute [simp]
+theorem reverse_cons (x : T) (l : list T) : reverse (x::l) = concat x (reverse l) :=
+rfl
+
+attribute [simp]
+theorem reverse_singleton (x : T) : reverse [x] = [x] :=
+rfl
+
+attribute [simp]
+theorem reverse_append : ∀ (s t : list T), reverse (s ++ t) = (reverse t) ++ (reverse s) :=
+sorry -- by rec_inst_simp
+
+attribute [simp]
+theorem reverse_reverse : ∀ (l : list T), reverse (reverse l) = l :=
+sorry -- by rec_inst_simp
+
+theorem concat_eq_reverse_cons (x : T) (l : list T) : concat x l = reverse (x :: reverse l) :=
+sorry -- by inst_simp
+
+theorem length_reverse : ∀ (l : list T), length (reverse l) = length l :=
+sorry -- by rec_inst_simp
+
+/- head and tail -/
+
+attribute [simp]
+theorem head_cons [h : inhabited T] (a : T) (l : list T) : head (a::l) = a :=
+rfl
+
+attribute [simp]
+theorem head_append [h : inhabited T] (t : list T) : ∀ {s : list T}, s ≠ [] → head (s ++ t) = head s :=
+sorry -- by rec_inst_simp
+
+attribute [simp]
+theorem tail_nil : tail (@nil T) = [] :=
+rfl
+
+attribute [simp]
+theorem tail_cons (a : T) (l : list T) : tail (a::l) = l :=
+rfl
+
+theorem cons_head_tail [h : inhabited T] {l : list T} : l ≠ [] → (head l)::(tail l) = l :=
+sorry -- by rec_inst_simp
+
+/- list membership -/
+
+definition mem : T → list T → Prop
+| a []       := false
+| a (b :: l) := a = b ∨ mem a l
+
+notation e ∈ s := mem e s
+notation e ∉ s := ¬ e ∈ s
+
+theorem mem_nil_iff (x : T) : x ∈ [] ↔ false :=
+iff.rfl
+
+theorem not_mem_nil (x : T) : x ∉ [] :=
+iff.mp $ mem_nil_iff x
+
+attribute [simp]
+theorem mem_cons (x : T) (l : list T) : x ∈ x :: l :=
+or.inl rfl
+
+theorem mem_cons_of_mem (y : T) {x : T} {l : list T} : x ∈ l → x ∈ y :: l :=
+assume H, or.inr H
+
+theorem mem_cons_iff (x y : T) (l : list T) : x ∈ y::l ↔ (x = y ∨ x ∈ l) :=
+iff.rfl
+
+theorem eq_or_mem_of_mem_cons {x y : T} {l : list T} : x ∈ y::l → x = y ∨ x ∈ l :=
+assume h, h
+
+theorem mem_singleton {x a : T} : x ∈ [a] → x = a :=
+suppose x ∈ [a], or.elim (eq_or_mem_of_mem_cons this)
+  (suppose x = a, this)
+  (suppose x ∈ [], absurd this (not_mem_nil x))
+
+theorem mem_of_mem_cons_of_mem {a b : T} {l : list T} : a ∈ b::l → b ∈ l → a ∈ l :=
+sorry
+/-
+assume ainbl binl, or.elim (eq_or_mem_of_mem_cons ainbl)
+  (suppose a = b, by substvars; exact binl)
+  (suppose a ∈ l, this)
+-/
+
+theorem mem_or_mem_of_mem_append {x : T} {s t : list T} : x ∈ s ++ t → x ∈ s ∨ x ∈ t :=
+list.induction_on s or.inr
+  (take y s,
+    assume IH : x ∈ s ++ t → x ∈ s ∨ x ∈ t,
+    suppose x ∈ y::s ++ t,
+    have x = y ∨ x ∈ s ++ t, from this,
+    have x = y ∨ x ∈ s ∨ x ∈ t, from or_of_or_of_imp_right this IH,
+    iff.elim_right or.assoc this)
+
+theorem mem_append_of_mem_or_mem {x : T} {s t : list T} : x ∈ s ∨ x ∈ t → x ∈ s ++ t :=
+list.induction_on s
+  (take H, or.elim H false.elim (assume H, H))
+  (take y s,
+    assume IH : x ∈ s ∨ x ∈ t → x ∈ s ++ t,
+    suppose x ∈ y::s ∨ x ∈ t,
+      or.elim this
+        (suppose x ∈ y::s,
+          or.elim (eq_or_mem_of_mem_cons this)
+            (suppose x = y, or.inl this)
+            (suppose x ∈ s, or.inr (IH (or.inl this))))
+        (suppose x ∈ t, or.inr (IH (or.inr this))))
+
+theorem mem_append_iff (x : T) (s t : list T) : x ∈ s ++ t ↔ x ∈ s ∨ x ∈ t :=
+iff.intro mem_or_mem_of_mem_append mem_append_of_mem_or_mem
+
+theorem not_mem_of_not_mem_append_left {x : T} {s t : list T} : x ∉ s++t → x ∉ s :=
+λ nxinst xins, absurd (mem_append_of_mem_or_mem (or.inl xins)) nxinst
+
+theorem not_mem_of_not_mem_append_right {x : T} {s t : list T} : x ∉ s++t → x ∉ t :=
+λ nxinst xint, absurd (mem_append_of_mem_or_mem (or.inr xint)) nxinst
+
+theorem not_mem_append {x : T} {s t : list T} : x ∉ s → x ∉ t → x ∉ s++t :=
+sorry
+/-
+λ nxins nxint xinst, or.elim (mem_or_mem_of_mem_append xinst)
+  (λ xins, by contradiction)
+  (λ xint, by contradiction)
+-/
+
+lemma length_pos_of_mem {a : T} : ∀ {l : list T}, a ∈ l → 0 < length l
+:= sorry
+/-
+| []     := assume Pinnil, by contradiction
+| (b::l) := assume Pin, !zero_lt_succ
+-/
+
+section
+local attribute mem [reducible]
+local attribute append [reducible]
+theorem mem_split {x : T} {l : list T} : x ∈ l → ∃s t : list T, l = s ++ (x::t) :=
+sorry
+/-
+list.induction_on l
+  (suppose x ∈ [], false.elim (iff.elim_left !mem_nil_iff this))
+  (take y l,
+    assume IH : x ∈ l → ∃s t : list T, l = s ++ (x::t),
+    suppose x ∈ y::l,
+    or.elim (eq_or_mem_of_mem_cons this)
+      (suppose x = y,
+        exists.intro [] (!exists.intro (this ▸ rfl)))
+      (suppose x ∈ l,
+        obtain s (H2 : ∃t : list T, l = s ++ (x::t)), from IH this,
+        obtain t (H3 : l = s ++ (x::t)), from H2,
+        have y :: l = (y::s) ++ (x::t),
+          from H3 ▸ rfl,
+        !exists.intro (!exists.intro this)))
+-/
+end
+
+theorem mem_append_left {a : T} {l₁ : list T} (l₂ : list T) : a ∈ l₁ → a ∈ l₁ ++ l₂ :=
+assume ainl₁, mem_append_of_mem_or_mem (or.inl ainl₁)
+
+theorem mem_append_right {a : T} (l₁ : list T) {l₂ : list T} : a ∈ l₂ → a ∈ l₁ ++ l₂ :=
+assume ainl₂, mem_append_of_mem_or_mem (or.inr ainl₂)
+
+attribute [instance]
+definition decidable_mem [H : decidable_eq T] (x : T) (l : list T) : decidable (x ∈ l) :=
+list.rec_on l
+  (decidable.ff (not_of_iff_false (mem_nil_iff _)))
+  (take (h : T) (l : list T) (iH : decidable (x ∈ l)),
+    show decidable (x ∈ h::l), from
+    decidable.rec_on iH
+      (suppose nxinl : ¬x ∈ l,
+        decidable.rec_on (H x h)
+          (suppose xneh : x ≠ h,
+            have ¬(x = h ∨ x ∈ l), from
+              suppose x = h ∨ x ∈ l, or.elim this
+                (suppose x = h, absurd this xneh)
+                (suppose x ∈ l, absurd this nxinl),
+            have ¬x ∈ h::l, from
+              iff.elim_right (not_iff_not_of_iff (mem_cons_iff x h l)) this,
+            decidable.ff this)
+          (suppose x = h, decidable.tt (or.inl this)))
+      (assume Hp : x ∈ l,
+        decidable.rec_on (H x h)
+          (suppose x ≠ h,
+            decidable.tt (or.inr Hp))
+          (suppose x = h,
+            decidable.tt (or.inl this))))
+
+theorem mem_of_ne_of_mem {x y : T} {l : list T} (H₁ : x ≠ y) (H₂ : x ∈ y :: l) : x ∈ l :=
+or.elim (eq_or_mem_of_mem_cons H₂) (λe, absurd e H₁) (λr, r)
+
+theorem ne_of_not_mem_cons {a b : T} {l : list T} : a ∉ b::l → a ≠ b :=
+assume nin aeqb, absurd (or.inl aeqb) nin
+
+theorem not_mem_of_not_mem_cons {a b : T} {l : list T} : a ∉ b::l → a ∉ l :=
+assume nin nainl, absurd (or.inr nainl) nin
+
+lemma not_mem_cons_of_ne_of_not_mem {x y : T} {l : list T} : x ≠ y → x ∉ l → x ∉ y::l :=
+assume P1 P2, not.intro (assume Pxin, absurd (eq_or_mem_of_mem_cons Pxin) (not_or P1 P2))
+
+lemma ne_and_not_mem_of_not_mem_cons {x y : T} {l : list T} : x ∉ y::l → x ≠ y ∧ x ∉ l :=
+assume P, and.intro (ne_of_not_mem_cons P) (not_mem_of_not_mem_cons P)
+
+definition sublist (l₁ l₂ : list T) := ∀ ⦃a : T⦄, a ∈ l₁ → a ∈ l₂
+
+infix ⊆ := sublist
+
+attribute [simp]
+theorem nil_sub (l : list T) : [] ⊆ l :=
+λ b i, false.elim (iff.mp (mem_nil_iff b) i)
+
+attribute [simp]
+theorem sub.refl (l : list T) : l ⊆ l :=
+λ b i, i
+
+theorem sub.trans {l₁ l₂ l₃ : list T} (H₁ : l₁ ⊆ l₂) (H₂ : l₂ ⊆ l₃) : l₁ ⊆ l₃ :=
+λ b i, H₂ (H₁ i)
+
+attribute [simp]
+theorem sub_cons (a : T) (l : list T) : l ⊆ a::l :=
+λ b i, or.inr i
+
+theorem sub_of_cons_sub {a : T} {l₁ l₂ : list T} : a::l₁ ⊆ l₂ → l₁ ⊆ l₂ :=
+λ s b i, s b (mem_cons_of_mem _ i)
+
+theorem cons_sub_cons  {l₁ l₂ : list T} (a : T) (s : l₁ ⊆ l₂) : (a::l₁) ⊆ (a::l₂) :=
+λ b Hin, or.elim (eq_or_mem_of_mem_cons Hin)
+  (λ e : b = a,  or.inl e)
+  (λ i : b ∈ l₁, or.inr (s i))
+
+attribute [simp]
+theorem sub_append_left (l₁ l₂ : list T) : l₁ ⊆ l₁++l₂ :=
+λ b i, iff.mpr (mem_append_iff b l₁ l₂) (or.inl i)
+
+attribute [simp]
+theorem sub_append_right (l₁ l₂ : list T) : l₂ ⊆ l₁++l₂ :=
+λ b i, iff.mpr (mem_append_iff b l₁ l₂) (or.inr i)
+
+theorem sub_cons_of_sub (a : T) {l₁ l₂ : list T} : l₁ ⊆ l₂ → l₁ ⊆ (a::l₂) :=
+λ (s : l₁ ⊆ l₂) (x : T) (i : x ∈ l₁), or.inr (s i)
+
+theorem sub_app_of_sub_left (l l₁ l₂ : list T) : l ⊆ l₁ → l ⊆ l₁++l₂ :=
+λ (s : l ⊆ l₁) (x : T) (xinl : x ∈ l),
+  have x ∈ l₁, from s xinl,
+  mem_append_of_mem_or_mem (or.inl this)
+
+theorem sub_app_of_sub_right (l l₁ l₂ : list T) : l ⊆ l₂ → l ⊆ l₁++l₂ :=
+λ (s : l ⊆ l₂) (x : T) (xinl : x ∈ l),
+  have x ∈ l₂, from s xinl,
+  mem_append_of_mem_or_mem (or.inr this)
+
+theorem cons_sub_of_sub_of_mem {a : T} {l m : list T} : a ∈ m → l ⊆ m → a::l ⊆ m :=
+sorry
+/-
+λ (ainm : a ∈ m) (lsubm : l ⊆ m) (x : T) (xinal : x ∈ a::l), or.elim (eq_or_mem_of_mem_cons xinal)
+  (suppose x = a, by substvars; exact ainm)
+  (suppose x ∈ l, lsubm this)
+-/
+
+theorem app_sub_of_sub_of_sub {l₁ l₂ l : list T} : l₁ ⊆ l → l₂ ⊆ l → l₁++l₂ ⊆ l :=
+λ (l₁subl : l₁ ⊆ l) (l₂subl : l₂ ⊆ l) (x : T) (xinl₁l₂ : x ∈ l₁++l₂),
+  or.elim (mem_or_mem_of_mem_append xinl₁l₂)
+    (suppose x ∈ l₁, l₁subl this)
+    (suppose x ∈ l₂, l₂subl this)
+
+/- find -/
+section
+variable [H : decidable_eq T]
+include H
+
+definition find : T → list T → nat
+| a []       := 0
+| a (b :: l) := if a = b then 0 else succ (find a l)
+
+attribute [simp]
+theorem find_nil (x : T) : find x [] = 0 :=
+rfl
+
+theorem find_cons (x y : T) (l : list T) : find x (y::l) = if x = y then 0 else succ (find x l) :=
+rfl
+
+theorem find_cons_of_eq {x y : T} (l : list T) : x = y → find x (y::l) = 0 :=
+assume e, if_pos e
+
+theorem find_cons_of_ne {x y : T} (l : list T) : x ≠ y → find x (y::l) = succ (find x l) :=
+assume n, if_neg n
+
+theorem find_of_not_mem {l : list T} {x : T} : ¬x ∈ l → find x l = length l :=
+sorry
+/-
+list.rec_on l
+   (suppose ¬x ∈ [], rfl)
+   (take y l,
+      assume iH : ¬x ∈ l → find x l = length l,
+      suppose ¬x ∈ y::l,
+      have ¬(x = y ∨ x ∈ l), from iff.elim_right (not_iff_not_of_iff !mem_cons_iff) this,
+      have ¬x = y ∧ ¬x ∈ l, from (iff.elim_left !not_or_iff_not_and_not this),
+      calc
+        find x (y::l) = if x = y then 0 else succ (find x l) : !find_cons
+                  ... = succ (find x l)                      : if_neg (and.elim_left this)
+                  ... = succ (length l)                      : by rewrite (iH (and.elim_right this))
+                  ... = length (y::l)                        : !length_cons⁻¹)
+-/
+
+lemma find_le_length : ∀ {a} {l : list T}, find a l ≤ length l
+:= sorry
+/-
+| a []        := !le.refl
+| a (b::l)    := decidable.rec_on (H a b)
+              (assume Peq, by rewrite [find_cons_of_eq l Peq]; exact !zero_le)
+              (assume Pne,
+                begin
+                  rewrite [find_cons_of_ne l Pne, length_cons],
+                  apply succ_le_succ, apply find_le_length
+                end)
+-/
+
+lemma not_mem_of_find_eq_length : ∀ {a} {l : list T}, find a l = length l → a ∉ l
+:= sorry
+/-
+| a []        := assume Peq, !not_mem_nil
+| a (b::l)    := decidable.rec_on (H a b)
+                (assume Peq, by rewrite [find_cons_of_eq l Peq, length_cons]; contradiction)
+                (assume Pne,
+                  begin
+                    rewrite [find_cons_of_ne l Pne, length_cons, mem_cons_iff],
+                    intro Plen, apply (not_or Pne),
+                    exact not_mem_of_find_eq_length (succ.inj Plen)
+                  end)
+-/
+
+lemma find_lt_length {a} {l : list T} (Pin : a ∈ l) : find a l < length l :=
+sorry
+/-
+begin
+  apply nat.lt_of_le_and_ne,
+  apply find_le_length,
+  apply not.intro, intro Peq,
+  exact absurd Pin (not_mem_of_find_eq_length Peq)
+end
+-/
+end
+
+/- nth element -/
+section nth
+attribute [simp]
+theorem nth_zero (a : T) (l : list T) : nth (a :: l) 0 = some a :=
+rfl
+
+attribute [simp]
+theorem nth_succ (a : T) (l : list T) (n : nat) : nth (a::l) (succ n) = nth l n :=
+rfl
+
+theorem nth_eq_some : ∀ {l : list T} {n : nat}, n < length l → Σ a : T, nth l n = some a
+:= sorry
+/-
+| []     n        h := absurd h !not_lt_zero
+| (a::l) 0        h := ⟨a, rfl⟩
+| (a::l) (succ n) h :=
+  have n < length l,                       from lt_of_succ_lt_succ h,
+  obtain (r : T) (req : nth l n = some r), from nth_eq_some this,
+  ⟨r, by rewrite [nth_succ, req]⟩
+-/
+
+open decidable
+theorem find_nth [decidable_eq T] {a : T} : ∀ {l}, a ∈ l → nth l (find a l) = some a
+:= sorry
+/-
+| []     ain   := absurd ain !not_mem_nil
+| (b::l) ainbl := by_cases
+  (λ aeqb : a = b, by rewrite [find_cons_of_eq _ aeqb, nth_zero, aeqb])
+  (λ aneb : a ≠ b, or.elim (eq_or_mem_of_mem_cons ainbl)
+    (λ aeqb : a = b, absurd aeqb aneb)
+    (λ ainl : a ∈ l, by rewrite [find_cons_of_ne _ aneb, nth_succ, find_nth ainl]))
+-/
+
+definition inth [h : inhabited T] (l : list T) (n : nat) : T :=
+match (nth l n) with
+| (some a) := a
+| none     := arbitrary T
+end
+
+theorem inth_zero [inhabited T] (a : T) (l : list T) : inth (a :: l) 0 = a :=
+rfl
+
+theorem inth_succ [inhabited T] (a : T) (l : list T) (n : nat) : inth (a::l) (n+1) = inth l n :=
+rfl
+
+end nth
+
+section ith
+definition ith : Π (l : list T) (i : nat), i < length l → T
+| nil     i        h := absurd h (not_lt_zero i)
+| (x::xs) 0        h := x
+| (x::xs) (succ i) h := ith xs i (lt_of_succ_lt_succ h)
+
+attribute [simp]
+lemma ith_zero (a : T) (l : list T) (h : 0 < length (a::l)) : ith (a::l) 0 h = a :=
+rfl
+
+attribute [simp]
+lemma ith_succ (a : T) (l : list T) (i : nat) (h : succ i < length (a::l))
+                      : ith (a::l) (succ i) h = ith l i (lt_of_succ_lt_succ h) :=
+rfl
+end ith
+
+open decidable
+
+/- quasiequal a l l' means that l' is exactly l, with a added
+   once somewhere -/
+section qeq
+variable {A : Type}
+inductive qeq (a : A) : list A → list A → Prop :=
+| qhead : ∀ l, qeq a l (a::l)
+| qcons : ∀ (b : A) {l l' : list A}, qeq a l l' → qeq a (b::l) (b::l')
+
+open qeq
+
+notation l' `≈`:50 a `|` l:50 := qeq a l l'
+
+theorem qeq_app : ∀ (l₁ : list A) (a : A) (l₂ : list A), l₁++(a::l₂) ≈ a|l₁++l₂
+| []      a l₂ := qhead a l₂
+| (x::xs) a l₂ := qcons x (qeq_app xs a l₂)
+
+theorem mem_head_of_qeq {a : A} {l₁ l₂ : list A} : l₁≈a|l₂ → a ∈ l₁ :=
+take q, qeq.induction_on q
+  (λ l, mem_cons a l)
+  (λ b l l' q r, or.inr r)
+
+theorem mem_tail_of_qeq {a : A} {l₁ l₂ : list A} : l₁≈a|l₂ → ∀ x, x ∈ l₂ → x ∈ l₁ :=
+take q, qeq.induction_on q
+  (λ l x i, or.inr i)
+  (λ b l l' q r x xinbl, or.elim (eq_or_mem_of_mem_cons xinbl)
+     (λ xeqb : x = b, xeqb ▸ mem_cons x l')
+     (λ xinl : x ∈ l, or.inr (r x xinl)))
+
+theorem mem_cons_of_qeq {a : A} {l₁ l₂ : list A} : l₁≈a|l₂ → ∀ x, x ∈ l₁ → x ∈ a::l₂ :=
+take q, qeq.induction_on q
+  (λ l x i, i)
+  (λ b l l' q r x xinbl', or.elim (eq_or_mem_of_mem_cons xinbl')
+    (λ xeqb  : x = b, xeqb ▸ or.inr (mem_cons x l))
+    (λ xinl' : x ∈ l', or.elim (eq_or_mem_of_mem_cons (r x xinl'))
+      (λ xeqa : x = a, xeqa ▸ mem_cons x (b::l))
+      (λ xinl : x ∈ l, or.inr (or.inr xinl))))
+
+theorem length_eq_of_qeq {a : A} {l₁ l₂ : list A} : l₁≈a|l₂ → length l₁ = succ (length l₂) :=
+sorry
+/-
+take q, qeq.induction_on q
+  (λ l, rfl)
+  (λ b l l' q r, by rewrite [*length_cons, r])
+-/
+
+theorem qeq_of_mem {a : A} {l : list A} : a ∈ l → (∃l', l≈a|l') :=
+sorry
+/-
+list.induction_on l
+  (λ h : a ∈ nil, absurd h (not_mem_nil a))
+  (λ x xs r ainxxs, or.elim (eq_or_mem_of_mem_cons ainxxs)
+    (λ aeqx  : a = x,
+       have aux : ∃ l, x::xs≈x|l, from
+         exists.intro xs (qhead x xs),
+       by rewrite aeqx; exact aux)
+    (λ ainxs : a ∈ xs,
+       have ∃l', xs ≈ a|l', from r ainxs,
+       obtain (l' : list A) (q : xs ≈ a|l'), from this,
+       have x::xs ≈ a | x::l', from qcons x q,
+       exists.intro (x::l') this))
+-/
+
+theorem qeq_split {a : A} {l l' : list A} : l'≈a|l → ∃l₁ l₂, l = l₁++l₂ ∧ l' = l₁++(a::l₂) :=
+sorry
+/-
+take q, qeq.induction_on q
+  (λ t,
+    have t = []++t ∧ a::t = []++(a::t), from and.intro rfl rfl,
+    exists.intro [] (exists.intro t this))
+  (λ b t t' q r,
+    obtain (l₁ l₂ : list A) (h : t = l₁++l₂ ∧ t' = l₁++(a::l₂)), from r,
+    have b::t = (b::l₁)++l₂ ∧ b::t' = (b::l₁)++(a::l₂),
+      begin
+        rewrite [and.elim_right h, and.elim_left h],
+        constructor, repeat reflexivity
+      end,
+    exists.intro (b::l₁) (exists.intro l₂ this))
+-/
+
+theorem sub_of_mem_of_sub_of_qeq {a : A} {l : list A} {u v : list A} : a ∉ l → a::l ⊆ v → v≈a|u → l ⊆ u :=
+sorry
+/-
+λ (nainl : a ∉ l) (s : a::l ⊆ v) (q : v≈a|u) (x : A) (xinl : x ∈ l),
+  have x ∈ v,    from s (or.inr xinl),
+  have x ∈ a::u, from mem_cons_of_qeq q x this,
+  or.elim (eq_or_mem_of_mem_cons this)
+    (suppose x = a, by substvars; contradiction)
+    (suppose x ∈ u, this)
+-/
+
+end qeq
+
+section firstn
+variable {A : Type}
+
+definition firstn : nat → list A → list A
+| 0     l      := []
+| (n+1) []     := []
+| (n+1) (a::l) := a :: firstn n l
+
+attribute [simp]
+lemma firstn_zero : ∀ (l : list A), firstn 0 l = [] :=
+sorry -- by intros; reflexivity
+
+attribute [simp]
+lemma firstn_nil : ∀ n, firstn n [] = ([] : list A)
+| 0     := rfl
+| (n+1) := rfl
+
+lemma firstn_cons : ∀ n (a : A) (l : list A), firstn (succ n) (a::l) = a :: firstn n l :=
+sorry -- by intros; reflexivity
+
+lemma firstn_all : ∀ (l : list A), firstn (length l) l = l
+| []     := rfl
+| (a::l) := sorry -- begin change a :: (firstn (length l) l) = a :: l, rewrite firstn_all end
+
+lemma firstn_all_of_ge : ∀ {n} {l : list A}, n ≥ length l → firstn n l = l
+| 0     []     h := rfl
+| 0     (a::l) h := absurd h (not_le_of_gt (succ_pos _))
+| (n+1) []     h := rfl
+| (n+1) (a::l) h :=
+  sorry
+  /-
+  begin
+    change a :: firstn n l = a :: l,
+    rewrite [firstn_all_of_ge (le_of_succ_le_succ h)]
+  end
+  -/
+
+lemma firstn_firstn : ∀ (n m) (l : list A), firstn n (firstn m l) = firstn (min n m) l
+| n         0        l      := sorry -- by rewrite [min_zero, firstn_zero, firstn_nil]
+| 0         m        l      := sorry -- by rewrite [zero_min]
+| (succ n)  (succ m) nil    := sorry -- by rewrite [*firstn_nil]
+| (succ n)  (succ m) (a::l) := sorry -- by rewrite [*firstn_cons, firstn_firstn, min_succ_succ]
+
+lemma length_firstn_le : ∀ (n) (l : list A), length (firstn n l) ≤ n
+| 0        l      := sorry -- by rewrite [firstn_zero]
+| (succ n) (a::l) := sorry -- by rewrite [firstn_cons, length_cons, add_one]; apply succ_le_succ; apply length_firstn_le
+| (succ n) []     := sorry -- by rewrite [firstn_nil, length_nil]; apply zero_le
+
+lemma length_firstn_eq : ∀ (n) (l : list A), length (firstn n l) = min n (length l)
+| 0        l      := sorry -- by rewrite [firstn_zero, zero_min]
+| (succ n) (a::l) := sorry -- by rewrite [firstn_cons, *length_cons, *add_one, min_succ_succ, length_firstn_eq]
+| (succ n) []     := sorry -- by rewrite [firstn_nil]
+end firstn
+
+section dropn
+variables {A : Type}
+-- 'dropn n l' drops the first 'n' elements of 'l'
+
+theorem length_dropn
+: ∀ (i : ℕ) (l : list A), length (dropn i l) = length l - i
+| 0 l := rfl
+| (succ i) [] := calc
+  length (dropn (succ i) []) = 0 - succ i : sorry -- by rewrite (nat.zero_sub (succ i))
+| (succ i) (x::l) := calc
+  length (dropn (succ i) (x::l))
+          = length (dropn i l)       : by reflexivity
+      ... = length l - i             : length_dropn i l
+      ... = succ (length l) - succ i : sorry -- by rewrite (succ_sub_succ (length l) i)
+end dropn
+
+section count
+variable {A : Type}
+variable [decA : decidable_eq A]
+include decA
+
+definition count (a : A) : list A → nat
+| []      := 0
+| (x::xs) := if a = x then succ (count xs) else count xs
+
+lemma count_nil (a : A) : count a [] = 0 :=
+rfl
+
+lemma count_cons (a b : A) (l : list A) : count a (b::l) = if a = b then succ (count a l) else count a l :=
+rfl
+
+lemma count_cons_eq (a : A) (l : list A) : count a (a::l) = succ (count a l) :=
+if_pos rfl
+
+lemma count_cons_of_ne {a b : A} (h : a ≠ b) (l : list A) : count a (b::l) = count a l :=
+if_neg h
+
+lemma count_cons_ge_count (a b : A) (l : list A) : count a (b::l) ≥ count a l :=
+sorry
+/-
+by_cases
+  (suppose a = b, begin subst b, rewrite count_cons_eq, apply le_succ end)
+  (suppose a ≠ b, begin rewrite (count_cons_of_ne this), apply le.refl end)
+-/
+
+lemma count_singleton (a : A) : count a [a] = 1 :=
+sorry -- by rewrite count_cons_eq
+
+lemma count_append (a : A) : ∀ l₁ l₂, count a (l₁++l₂) = count a l₁ + count a l₂
+:= sorry
+/-
+| []      l₂ := by rewrite [append_nil_left, count_nil, zero_add]
+| (b::l₁) l₂ := by_cases
+  (suppose a = b, by rewrite [-this, append_cons, *count_cons_eq, succ_add, count_append])
+  (suppose a ≠ b, by rewrite [append_cons, *count_cons_of_ne this, count_append])
+-/
+
+lemma count_concat (a : A) (l : list A) : count a (concat a l) = succ (count a l) :=
+sorry -- by rewrite [concat_eq_append, count_append, count_singleton]
+
+lemma mem_of_count_gt_zero : ∀ {a : A} {l : list A}, count a l > 0 → a ∈ l
+:= sorry
+/-
+| a []     h := absurd h !lt.irrefl
+| a (b::l) h := by_cases
+  (suppose a = b, begin subst b, apply mem_cons end)
+  (suppose a ≠ b,
+   have count a l > 0, by rewrite [count_cons_of_ne this at h]; exact h,
+   have a ∈ l,    from mem_of_count_gt_zero this,
+   show a ∈ b::l, from mem_cons_of_mem _ this)
+-/
+
+lemma count_gt_zero_of_mem : ∀ {a : A} {l : list A}, a ∈ l → count a l > 0
+:= sorry
+/-
+| a []     h := absurd h !not_mem_nil
+| a (b::l) h := or.elim h
+  (suppose a = b, begin subst b, rewrite count_cons_eq, apply zero_lt_succ end)
+  (suppose a ∈ l, calc
+   count a (b::l) ≥ count a l : !count_cons_ge_count
+           ...    > 0         : count_gt_zero_of_mem this)
+-/
+
+lemma count_eq_zero_of_not_mem {a : A} {l : list A} (h : a ∉ l) : count a l = 0 :=
+sorry
+/-
+have ∀ n, count a l = n → count a l = 0,
+  begin
+    intro n, cases n,
+     { intro this, exact this },
+     { intro this, exact absurd (mem_of_count_gt_zero (begin rewrite this, exact dec_trivial end)) h }
+  end,
+this (count a l) rfl
+-/
+
+end count
+end list
+
+attribute list.decidable_mem    [instance]

old_library/data/list/comb.lean

@@ -0,0 +1,712 @@
+/-
+Copyright (c) 2015 Leonardo de Moura. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura, Haitao Zhang, Floris van Doorn
+
+List combinators.
+-/
+-- TODO(Leo): uncomment data.equiv after refactoring
+import data.list.basic -- data.equiv
+open nat prod decidable function
+
+namespace list
+variables {A B C : Type}
+
+section replicate
+
+-- 'replicate i n' returns the list contain i copies of n.
+definition replicate : ℕ → A → list A
+| 0 a := []
+| (succ n) a := a :: replicate n a
+
+theorem length_replicate : ∀ (i : ℕ) (a : A), length (replicate i a) = i
+| 0 a := rfl
+| (succ i) a := calc
+  length (replicate (succ i) a) = length (replicate i a) + 1 : rfl
+                           ...  = i + 1                      : sorry -- by rewrite length_replicate
+end replicate
+
+/- map -/
+theorem map_nil (f : A → B) : map f [] = [] := rfl
+
+theorem map_cons (f : A → B) (a : A) (l : list A) : map f (a :: l) = f a :: map f l := rfl
+
+lemma map_concat (f : A → B) (a : A) : Πl, map f (concat a l) = concat (f a) (map f l)
+| nil    := rfl
+| (b::l) := sorry -- begin rewrite [concat_cons, +map_cons, concat_cons, map_concat] end
+
+lemma map_append (f : A → B) : ∀ l₁ l₂, map f (l₁++l₂) = (map f l₁)++(map f l₂)
+| nil    := take l, rfl
+| (a::l) := take l', sorry -- begin rewrite [append_cons, *map_cons, append_cons, map_append] end
+
+lemma map_reverse (f : A → B) : Πl, map f (reverse l) = reverse (map f l)
+| nil    := rfl
+| (b::l) := sorry -- begin rewrite [reverse_cons, +map_cons, reverse_cons, map_concat, map_reverse] end
+
+lemma map_singleton (f : A → B) (a : A) : map f [a] = [f a] := rfl
+
+attribute [simp]
+theorem map_id : ∀ l : list A, map id l = l
+| []      := rfl
+| (x::xs) := sorry -- begin rewrite [map_cons, map_id] end
+
+theorem map_id' {f : A → A} (H : ∀x, f x = x) : ∀ l : list A, map f l = l
+| []      := rfl
+| (x::xs) := sorry -- begin rewrite [map_cons, H, map_id'] end
+
+attribute [simp]
+theorem map_map (g : B → C) (f : A → B) : ∀ l, map g (map f l) = map (g ∘ f) l
+| []       := rfl
+| (a :: l) :=
+  show (g ∘ f) a :: map g (map f l) = map (g ∘ f) (a :: l),
+  from sorry -- by rewrite (map_map l)
+
+attribute [simp]
+theorem length_map (f : A → B) : ∀ l : list A, length (map f l) = length l
+| []       := sorry -- by esimp
+| (a :: l) :=
+  show length (map f l) + 1 = length l + 1,
+  from sorry -- by rewrite (length_map l)
+
+theorem map_ne_nil_of_ne_nil (f : A → B) {l : list A} (H : l ≠ nil) : map f l ≠ nil :=
+sorry
+/-
+suppose h₁ : map f l = nil,
+have length (map f l) = length l, from !length_map,
+have 0 = length l, from calc
+     0 = length (@nil B)  : by rewrite length_nil
+   ... = length (map f l) : by rewrite h₁
+   ... = length l : this,
+have l = nil, from eq_nil_of_length_eq_zero (eq.symm this),
+H this
+-/
+
+theorem mem_map {A B : Type} (f : A → B) : ∀ {a l}, a ∈ l → f a ∈ map f l
+:= sorry
+/-
+| a []      i := absurd i !not_mem_nil
+| a (x::xs) i := or.elim (eq_or_mem_of_mem_cons i)
+   (suppose a = x, by rewrite [this, map_cons]; apply mem_cons)
+   (suppose a ∈ xs, or.inr (mem_map this))
+-/
+
+theorem exists_of_mem_map {A B : Type} {f : A → B} {b : B} :
+    ∀{l}, b ∈ map f l → ∃a, a ∈ l ∧ f a = b
+:= sorry
+/-
+| []     H := false.elim H
+| (c::l) H := or.elim (iff.mp !mem_cons_iff H)
+                (suppose b = f c,
+                  exists.intro c (and.intro !mem_cons (eq.symm this)))
+                (suppose b ∈ map f l,
+                  obtain a (Hl : a ∈ l) (Hr : f a = b), from exists_of_mem_map this,
+                  exists.intro a (and.intro (mem_cons_of_mem _ Hl) Hr))
+-/
+
+theorem eq_of_map_const {A B : Type} {b₁ b₂ : B} : ∀ {l : list A}, b₁ ∈ map (const A b₂) l → b₁ = b₂
+| []     h := absurd h (not_mem_nil b₁)
+| (a::l) h :=
+  or.elim (eq_or_mem_of_mem_cons h)
+    (suppose b₁ = b₂, this)
+    (suppose b₁ ∈ map (const A b₂) l, eq_of_map_const this)
+
+definition map₂ (f : A → B → C) : list A → list B → list C
+| []      _       := []
+| _       []      := []
+| (x::xs) (y::ys) := f x y :: map₂ xs ys
+
+theorem map₂_nil1 (f : A → B → C) : ∀ (l : list B), map₂ f [] l = []
+| []     := rfl
+| (a::y) := rfl
+
+theorem map₂_nil2 (f : A → B → C) : ∀ (l : list A), map₂ f l [] = []
+| []     := rfl
+| (a::y) := rfl
+
+theorem length_map₂ : ∀(f : A → B → C) x y, length (map₂ f x y) = min (length x) (length y)
+| f []       [] := rfl
+| f (xh::xr) [] := rfl
+| f [] (yh::yr) := rfl
+| f (xh::xr) (yh::yr) := calc
+  length (map₂ f (xh::xr) (yh::yr))
+          = length (map₂ f xr yr) + 1                 : rfl
+      ... = min (length xr) (length yr) + 1           : sorry -- by rewrite length_map₂
+      ... = min (succ (length xr)) (succ (length yr)) : sorry -- by rewrite min_succ_succ
+      ... = min (length (xh::xr)) (length (yh::yr))   : rfl
+
+/- filter -/
+attribute [simp]
+theorem filter_nil (p : A → Prop) [h : decidable_pred p] : filter p [] = [] := rfl
+
+attribute [simp]
+theorem filter_cons_of_pos {p : A → Prop} [h : decidable_pred p] {a : A} : ∀ l, p a → filter p (a::l) = a :: filter p l :=
+λ l pa, if_pos pa
+
+attribute [simp]
+theorem filter_cons_of_neg {p : A → Prop} [h : decidable_pred p] {a : A} : ∀ l, ¬ p a → filter p (a::l) = filter p l :=
+λ l pa, if_neg pa
+
+theorem of_mem_filter {p : A → Prop} [h : decidable_pred p] {a : A} : ∀ {l}, a ∈ filter p l → p a
+| []     ain := absurd ain (not_mem_nil a)
+| (b::l) ain :=
+  sorry
+  /-
+  by_cases
+  (assume pb  : p b,
+    have a ∈ b :: filter p l, by rewrite [filter_cons_of_pos _ pb at ain]; exact ain,
+    or.elim (eq_or_mem_of_mem_cons this)
+      (suppose a = b, by rewrite [-this at pb]; exact pb)
+      (suppose a ∈ filter p l, of_mem_filter this))
+  (suppose ¬ p b, by rewrite [filter_cons_of_neg _ this at ain]; exact (of_mem_filter ain))
+  -/
+
+theorem mem_of_mem_filter {p : A → Prop} [h : decidable_pred p] {a : A} : ∀ {l}, a ∈ filter p l → a ∈ l
+| []     ain := absurd ain (not_mem_nil a)
+| (b::l) ain :=
+  sorry
+  /-
+  by_cases
+  (λ pb  : p b,
+    have a ∈ b :: filter p l, by rewrite [filter_cons_of_pos _ pb at ain]; exact ain,
+    or.elim (eq_or_mem_of_mem_cons this)
+      (suppose a = b, by rewrite this; exact !mem_cons)
+      (suppose a ∈ filter p l, mem_cons_of_mem _ (mem_of_mem_filter this)))
+  (suppose ¬ p b, by rewrite [filter_cons_of_neg _ this at ain]; exact (mem_cons_of_mem _ (mem_of_mem_filter ain)))
+  -/
+
+theorem mem_filter_of_mem {p : A → Prop} [h : decidable_pred p] {a : A} : ∀ {l}, a ∈ l → p a → a ∈ filter p l
+:= sorry
+/-
+| []     ain pa := absurd ain !not_mem_nil
+| (b::l) ain pa := by_cases
+  (λ pb  : p b, or.elim (eq_or_mem_of_mem_cons ain)
+    (λ aeqb : a = b, by rewrite [filter_cons_of_pos _ pb, aeqb]; exact !mem_cons)
+    (λ ainl : a ∈ l, by rewrite [filter_cons_of_pos _ pb]; exact (mem_cons_of_mem _ (mem_filter_of_mem ainl pa))))
+  (λ npb : ¬ p b, or.elim (eq_or_mem_of_mem_cons ain)
+    (λ aeqb : a = b, absurd (eq.rec_on aeqb pa) npb)
+    (λ ainl : a ∈ l, by rewrite [filter_cons_of_neg _ npb]; exact (mem_filter_of_mem ainl pa)))
+-/
+
+attribute [simp]
+theorem filter_sub {p : A → Prop} [h : decidable_pred p] (l : list A) : filter p l ⊆ l :=
+λ a ain, mem_of_mem_filter ain
+
+theorem filter_append {p : A → Prop} [h : decidable_pred p] : ∀ (l₁ l₂ : list A), filter p (l₁++l₂) = filter p l₁ ++ filter p l₂
+:= sorry
+/-
+| []      l₂ := rfl
+| (a::l₁) l₂ := by_cases
+  (suppose p a, by rewrite [append_cons, *filter_cons_of_pos _ this, filter_append])
+  (suppose ¬ p a, by rewrite [append_cons, *filter_cons_of_neg _ this, filter_append])
+-/
+
+/- foldl & foldr -/
+definition foldl (f : A → B → A) : A → list B → A
+| a []       := a
+| a (b :: l) := foldl (f a b) l
+
+attribute [simp]
+theorem foldl_nil (f : A → B → A) (a : A) : foldl f a [] = a := rfl
+
+attribute [simp]
+theorem foldl_cons (f : A → B → A) (a : A) (b : B) (l : list B) : foldl f a (b::l) = foldl f (f a b) l := rfl
+
+definition foldr (f : A → B → B) : B → list A → B
+| b []       := b
+| b (a :: l) := f a (foldr b l)
+
+attribute [simp]
+theorem foldr_nil (f : A → B → B) (b : B) : foldr f b [] = b := rfl
+
+attribute [simp]
+theorem foldr_cons (f : A → B → B) (b : B) (a : A) (l : list A) : foldr f b (a::l) = f a (foldr f b l) := rfl
+
+section foldl_eq_foldr
+  -- foldl and foldr coincide when f is commutative and associative
+  parameters {α : Type} {f : α → α → α}
+  hypothesis (Hcomm  : ∀ a b, f a b = f b a)
+  hypothesis (Hassoc : ∀ a b c, f (f a b) c = f a (f b c))
+  include Hcomm Hassoc
+
+  theorem foldl_eq_of_comm_of_assoc : ∀ a b l, foldl f a (b::l) = f b (foldl f a l)
+  := sorry
+  /-
+  | a b  nil    := Hcomm a b
+  | a b  (c::l) :=
+    begin
+      change foldl f (f (f a b) c) l = f b (foldl f (f a c) l),
+      rewrite -foldl_eq_of_comm_of_assoc,
+      change foldl f (f (f a b) c) l = foldl f (f (f a c) b) l,
+      have H₁ : f (f a b) c = f (f a c) b, by rewrite [Hassoc, Hassoc, Hcomm b c],
+      rewrite H₁
+    end
+  -/
+
+  theorem foldl_eq_foldr : ∀ a l, foldl f a l = foldr f a l
+  := sorry
+  /-
+  | a nil      := rfl
+  | a (b :: l) :=
+    begin
+      rewrite foldl_eq_of_comm_of_assoc,
+      esimp,
+      change f b (foldl f a l) = f b (foldr f a l),
+      rewrite foldl_eq_foldr
+    end
+  -/
+
+end foldl_eq_foldr
+
+attribute [simp]
+theorem foldl_append (f : B → A → B) : ∀ (b : B) (l₁ l₂ : list A), foldl f b (l₁++l₂) = foldl f (foldl f b l₁) l₂
+| b []      l₂ := rfl
+| b (a::l₁) l₂ := sorry -- by rewrite [append_cons, *foldl_cons, foldl_append]
+
+attribute [simp]
+theorem foldr_append (f : A → B → B) : ∀ (b : B) (l₁ l₂ : list A), foldr f b (l₁++l₂) = foldr f (foldr f b l₂) l₁
+| b []      l₂ := rfl
+| b (a::l₁) l₂ := sorry -- by rewrite [append_cons, *foldr_cons, foldr_append]
+
+/- all & any -/
+definition all (l : list A) (p : A → Prop) : Prop :=
+foldr (λ a r, p a ∧ r) true l
+
+definition any (l : list A) (p : A → Prop) : Prop :=
+foldr (λ a r, p a ∨ r) false l
+
+attribute [simp]
+theorem all_nil_eq (p : A → Prop) : all [] p = true := rfl
+
+theorem all_nil (p : A → Prop) : all [] p := trivial
+
+theorem all_cons_eq (p : A → Prop) (a : A) (l : list A) : all (a::l) p = (p a ∧ all l p) := rfl
+
+theorem all_cons {p : A → Prop} {a : A} {l : list A} (H1 : p a) (H2 : all l p) : all (a::l) p :=
+and.intro H1 H2
+
+theorem all_of_all_cons {p : A → Prop} {a : A} {l : list A} : all (a::l) p → all l p :=
+sorry -- assume h, by rewrite [all_cons_eq at h]; exact (and.elim_right h)
+
+theorem of_all_cons {p : A → Prop} {a : A} {l : list A} : all (a::l) p → p a :=
+sorry -- assume h, by rewrite [all_cons_eq at h]; exact (and.elim_left h)
+
+theorem all_cons_of_all {p : A → Prop} {a : A} {l : list A} : p a → all l p → all (a::l) p :=
+assume pa alllp, and.intro pa alllp
+
+theorem all_implies {p q : A → Prop} : ∀ {l}, all l p → (∀ x, p x → q x) → all l q
+| []     h₁ h₂ := trivial
+| (a::l) h₁ h₂ :=
+  have h₃ : all l q, from all_implies (all_of_all_cons h₁) h₂,
+  have q a, from h₂ a (of_all_cons h₁),
+  all_cons_of_all this h₃
+
+theorem of_mem_of_all {p : A → Prop} {a : A} : ∀ {l}, a ∈ l → all l p → p a
+:= sorry
+/-
+| []     h₁ h₂ := absurd h₁ !not_mem_nil
+| (b::l) h₁ h₂ :=
+  or.elim (eq_or_mem_of_mem_cons h₁)
+    (suppose a = b,
+      by rewrite [all_cons_eq at h₂, -this at h₂]; exact (and.elim_left h₂))
+    (suppose a ∈ l,
+      have all l p, by rewrite [all_cons_eq at h₂]; exact (and.elim_right h₂),
+      of_mem_of_all `a ∈ l` this)
+-/
+
+theorem all_of_forall {p : A → Prop} : ∀ {l}, (∀a, a ∈ l → p a) → all l p
+| []     H := all_nil p
+| (a::l) H := all_cons (H a (mem_cons a l))
+                       (all_of_forall (λ a' H', H a' (mem_cons_of_mem _ H')))
+
+attribute [simp]
+theorem any_nil (p : A → Prop) : any [] p = false := rfl
+
+attribute [simp]
+theorem any_cons (p : A → Prop) (a : A) (l : list A) : any (a::l) p = (p a ∨ any l p) := rfl
+
+theorem any_of_mem {p : A → Prop} {a : A} : ∀ {l}, a ∈ l → p a → any l p
+:= sorry
+/-
+| []     i h := absurd i !not_mem_nil
+| (b::l) i h :=
+  or.elim (eq_or_mem_of_mem_cons i)
+    (suppose a = b, by rewrite [-this]; exact (or.inl h))
+    (suppose a ∈ l,
+      have any l p, from any_of_mem this h,
+      or.inr this)
+-/
+
+theorem exists_of_any {p : A → Prop} : ∀{l : list A}, any l p → ∃a, a ∈ l ∧ p a
+:= sorry
+/-
+| []     H := false.elim H
+| (b::l) H := or.elim H
+                (assume H1 : p b, exists.intro b (and.intro !mem_cons H1))
+                (assume H1 : any l p,
+                  obtain a (H2l : a ∈ l) (H2r : p a), from exists_of_any H1,
+                  exists.intro a (and.intro (mem_cons_of_mem b H2l) H2r))
+-/
+
+definition decidable_all (p : A → Prop) [H : decidable_pred p] : ∀ l, decidable (all l p)
+| []       := decidable_true
+| (a :: l) :=
+  match (H a) with
+  | (tt Hp₁) :=
+    match (decidable_all l) with
+    | (tt Hp₂) := tt (and.intro Hp₁ Hp₂)
+    | (ff Hn₂) := ff (not_and_of_not_right (p a) Hn₂)
+    end
+  | (ff Hn) := ff (not_and_of_not_left (all l p) Hn)
+  end
+
+definition decidable_any (p : A → Prop) [H : decidable_pred p] : ∀ l, decidable (any l p)
+| []       := decidable_false
+| (a :: l) :=
+  match (H a) with
+  | (tt Hp) := tt (or.inl Hp)
+  | (ff Hn₁) :=
+    match (decidable_any l) with
+    | (tt Hp₂) := tt (or.inr Hp₂)
+    | (ff Hn₂) := ff (not_or Hn₁ Hn₂)
+    end
+  end
+
+/- zip & unzip -/
+definition zip (l₁ : list A) (l₂ : list B) : list (A × B) :=
+map₂ (λ a b, (a, b)) l₁ l₂
+
+definition unzip : list (A × B) → list A × list B
+| []            := ([], [])
+| ((a, b) :: l) :=
+  match (unzip l) with
+  | (la, lb) := (a :: la, b :: lb)
+  end
+
+attribute [simp]
+theorem unzip_nil : unzip (@nil (A × B)) = ([], []) := rfl
+
+attribute [simp]
+theorem unzip_cons (a : A) (b : B) (l : list (A × B)) :
+   unzip ((a, b) :: l) = match (unzip l) with (la, lb) := (a :: la, b :: lb) end :=
+rfl
+
+theorem zip_unzip : ∀ (l : list (A × B)), zip (pr₁ (unzip l)) (pr₂ (unzip l)) = l
+| []            := rfl
+| ((a, b) :: l) :=
+  sorry
+  /-
+  begin
+    rewrite unzip_cons,
+    have r : zip (pr₁ (unzip l)) (pr₂ (unzip l)) = l, from zip_unzip l,
+    revert r,
+    eapply prod.cases_on (unzip l),
+    intro la lb r,
+    rewrite -r
+  end
+  -/
+
+section mapAccumR
+variable {S : Type}
+
+-- This runs a function over a list returning the intermediate results and a
+-- a final result.
+definition mapAccumR : (A → S → S × B) → list A → S → (S × list B)
+| f [] c := (c, [])
+| f (y::yr) c :=
+  let r := mapAccumR f yr c in
+  let z := f y (pr₁ r) in
+  (pr₁ z, pr₂ z :: pr₂ r)
+
+theorem length_mapAccumR
+: ∀ (f : A → S → S × B) (x : list A) (s : S),
+  length (pr₂ (mapAccumR f x s)) = length x
+:= sorry
+/-
+| f (a::x) s := calc
+  length (pr₂ (mapAccumR f (a::x) s))
+                = length x + 1              : by rewrite -(length_mapAccumR f x s)
+            ... = length (a::x)             : rfl
+| f [] s := calc  length (pr₂ (mapAccumR f [] s)) = 0 : by esimp
+-/
+end mapAccumR
+
+section mapAccumR₂
+variable {S : Type}
+-- This runs a function over two lists returning the intermediate results and a
+-- a final result.
+definition mapAccumR₂
+: (A → B → S → S × C) → list A → list B → S → S × list C
+| f [] _ c := (c,[])
+| f _ [] c := (c,[])
+| f (x::xr) (y::yr) c :=
+  let r := mapAccumR₂ f xr yr c in
+  let q := f x y (pr₁ r) in
+  (pr₁ q, pr₂ q :: (pr₂ r))
+
+theorem length_mapAccumR₂
+: ∀ (f : A → B → S → S × C) (x : list A) (y : list B) (c : S),
+  length (pr₂ (mapAccumR₂ f x y c)) = min (length x) (length y)
+:= sorry
+/-
+| f (a::x) (b::y) c := calc
+    length (pr₂ (mapAccumR₂ f (a::x) (b::y) c))
+              = length (pr₂ (mapAccumR₂ f x y c)) + 1  : rfl
+          ... = min (length x) (length y) + 1             : by rewrite (length_mapAccumR₂ f x y c)
+          ... = min (succ (length x)) (succ (length y))   : by rewrite min_succ_succ
+          ... = min (length (a::x)) (length (b::y))       : rfl
+| f (a::x) [] c := rfl
+| f [] (b::y) c := rfl
+| f [] []     c := rfl
+-/
+end mapAccumR₂
+
+/- flat -/
+definition flat (l : list (list A)) : list A :=
+foldl append nil l
+
+/- product -/
+section product
+
+definition product : list A → list B → list (A × B)
+| []      l₂ := []
+| (a::l₁) l₂ := map (λ b, (a, b)) l₂ ++ product l₁ l₂
+
+theorem nil_product (l : list B) : product (@nil A) l = [] := rfl
+
+theorem product_cons (a : A) (l₁ : list A) (l₂ : list B)
+        : product (a::l₁) l₂ = map (λ b, (a, b)) l₂ ++ product l₁ l₂ := rfl
+
+theorem product_nil : ∀ (l : list A), product l (@nil B) = []
+| []     := rfl
+| (a::l) := sorry -- by rewrite [product_cons, map_nil, product_nil]
+
+theorem eq_of_mem_map_pair₁  {a₁ a : A} {b₁ : B} {l : list B} : (a₁, b₁) ∈ map (λ b, (a, b)) l → a₁ = a :=
+sorry
+/-
+assume ain,
+have pr1 (a₁, b₁) ∈ map pr1 (map (λ b, (a, b)) l), from mem_map pr1 ain,
+have a₁ ∈ map (λb, a) l, by revert this; rewrite [map_map, ↑pr1]; intro this; assumption,
+eq_of_map_const this
+-/
+
+theorem mem_of_mem_map_pair₁ {a₁ a : A} {b₁ : B} {l : list B} : (a₁, b₁) ∈ map (λ b, (a, b)) l → b₁ ∈ l :=
+sorry
+/-
+assume ain,
+have pr2 (a₁, b₁) ∈ map pr2 (map (λ b, (a, b)) l), from mem_map pr2 ain,
+have b₁ ∈ map (λx, x) l, by rewrite [map_map at this, ↑pr2 at this]; exact this,
+by rewrite [map_id at this]; exact this
+-/
+
+theorem mem_product {a : A} {b : B} : ∀ {l₁ l₂}, a ∈ l₁ → b ∈ l₂ → (a, b) ∈ product l₁ l₂
+:= sorry
+/-
+| []      l₂ h₁ h₂ := absurd h₁ !not_mem_nil
+| (x::l₁) l₂ h₁ h₂ :=
+  or.elim (eq_or_mem_of_mem_cons h₁)
+    (assume aeqx  : a = x,
+      have (a, b) ∈ map (λ b, (a, b)) l₂, from mem_map _ h₂,
+      begin rewrite [-aeqx, product_cons], exact mem_append_left _ this end)
+    (assume ainl₁ : a ∈ l₁,
+      have (a, b) ∈ product l₁ l₂, from mem_product ainl₁ h₂,
+      begin rewrite [product_cons], exact mem_append_right _ this end)
+-/
+
+theorem mem_of_mem_product_left {a : A} {b : B} : ∀ {l₁ l₂}, (a, b) ∈ product l₁ l₂ → a ∈ l₁
+:= sorry
+/-
+| []      l₂ h := absurd h !not_mem_nil
+| (x::l₁) l₂ h :=
+  or.elim (mem_or_mem_of_mem_append h)
+    (suppose (a, b) ∈ map (λ b, (x, b)) l₂,
+       have a = x, from eq_of_mem_map_pair₁ this,
+       by rewrite this; exact !mem_cons)
+    (suppose (a, b) ∈ product l₁ l₂,
+      have a ∈ l₁, from mem_of_mem_product_left this,
+      mem_cons_of_mem _ this)
+-/
+
+theorem mem_of_mem_product_right {a : A} {b : B} : ∀ {l₁ l₂}, (a, b) ∈ product l₁ l₂ → b ∈ l₂
+| []      l₂ h := absurd h (not_mem_nil ((a, b)))
+| (x::l₁) l₂ h :=
+  or.elim (mem_or_mem_of_mem_append h)
+    (suppose (a, b) ∈ map (λ b, (x, b)) l₂,
+      mem_of_mem_map_pair₁ this)
+    (suppose (a, b) ∈ product l₁ l₂,
+      mem_of_mem_product_right this)
+
+theorem length_product : ∀ (l₁ : list A) (l₂ : list B), length (product l₁ l₂) = length l₁ * length l₂
+:= sorry
+/-
+| []      l₂ := by rewrite [length_nil, zero_mul]
+| (x::l₁) l₂ :=
+  have length (product l₁ l₂) = length l₁ * length l₂, from length_product l₁ l₂,
+  by rewrite [product_cons, length_append, length_cons,
+              length_map, this, right_distrib, one_mul, add.comm]
+-/
+end product
+
+-- new for list/comb dependent map theory
+definition dinj₁ (p : A → Prop) (f : Π a, p a → B) := ∀ ⦃a1 a2⦄ (h1 : p a1) (h2 : p a2), a1 ≠ a2 → (f a1 h1) ≠ (f a2 h2)
+definition dinj (p : A → Prop) (f : Π a, p a → B) := ∀ ⦃a1 a2⦄ (h1 : p a1) (h2 : p a2), (f a1 h1) = (f a2 h2) → a1 = a2
+
+definition dmap (p : A → Prop) [h : decidable_pred p] (f : Π a, p a → B) : list A → list B
+| []       := []
+| (a::l)   := if P : (p a) then cons (f a P) (dmap l) else (dmap l)
+
+-- properties of dmap
+section dmap
+
+variable {p : A → Prop}
+variable [h : decidable_pred p]
+include h
+variable {f : Π a, p a → B}
+
+lemma dmap_nil : dmap p f [] = [] := rfl
+lemma dmap_cons_of_pos {a : A} (P : p a) : ∀ l, dmap p f (a::l) = (f a P) :: dmap p f l :=
+      λ l, dif_pos P
+lemma dmap_cons_of_neg {a : A} (P : ¬ p a) : ∀ l, dmap p f (a::l) = dmap p f l :=
+      λ l, dif_neg P
+
+lemma mem_dmap : ∀ {l : list A} {a} (Pa : p a), a ∈ l → (f a Pa) ∈ dmap p f l
+:= sorry
+/-
+| []     := take a Pa Pinnil, by contradiction
+| (a::l) := take b Pb Pbin, or.elim (eq_or_mem_of_mem_cons Pbin)
+              (assume Pbeqa, begin
+                rewrite [eq.symm Pbeqa, dmap_cons_of_pos Pb],
+                exact !mem_cons
+              end)
+              (assume Pbinl,
+                decidable.rec_on (h a)
+                (assume Pa, begin
+                  rewrite [dmap_cons_of_pos Pa],
+                  apply mem_cons_of_mem,
+                  exact mem_dmap Pb Pbinl
+                end)
+                (assume nPa, begin
+                  rewrite [dmap_cons_of_neg nPa],
+                  exact mem_dmap Pb Pbinl
+                end))
+-/
+
+lemma exists_of_mem_dmap : ∀ {l : list A} {b : B}, b ∈ dmap p f l → ∃ a P, a ∈ l ∧ b = f a P
+:= sorry
+/-
+| []     := take b, by rewrite dmap_nil; contradiction
+| (a::l) := take b, decidable.rec_on (h a)
+  (assume Pa, begin
+  rewrite [dmap_cons_of_pos Pa, mem_cons_iff],
+  intro Pb, cases Pb with Peq Pin,
+    exact exists.intro a (exists.intro Pa (and.intro !mem_cons Peq)),
+    have Pex : ∃ (a : A) (P : p a), a ∈ l ∧ b = f a P, from exists_of_mem_dmap Pin,
+    cases Pex with a' Pex', cases Pex' with Pa' P',
+    exact exists.intro a' (exists.intro Pa' (and.intro (mem_cons_of_mem a (and.left P')) (and.right P')))
+  end)
+  (assume nPa,  begin
+  rewrite [dmap_cons_of_neg nPa],
+  intro Pin,
+  have Pex : ∃ (a : A) (P : p a), a ∈ l ∧ b = f a P, from exists_of_mem_dmap Pin,
+  cases Pex with a' Pex', cases Pex' with Pa' P',
+  exact exists.intro a' (exists.intro Pa' (and.intro (mem_cons_of_mem a (and.left P')) (and.right P')))
+  end)
+-/
+
+lemma map_dmap_of_inv_of_pos {g : B → A} (Pinv : ∀ a (Pa : p a), g (f a Pa) = a) :
+                          ∀ {l : list A}, (∀ ⦃a⦄, a ∈ l → p a) → map g (dmap p f l) = l
+:= sorry
+/-
+| []     := assume Pl, by rewrite [dmap_nil, map_nil]
+| (a::l) := assume Pal,
+            have Pa : p a, from Pal a !mem_cons,
+            have Pl : ∀ a, a ∈ l → p a,
+              from take x Pxin, Pal x (mem_cons_of_mem a Pxin),
+            by rewrite [dmap_cons_of_pos Pa, map_cons, Pinv, map_dmap_of_inv_of_pos Pl]
+-/
+
+lemma mem_of_dinj_of_mem_dmap (Pdi : dinj p f) :
+      ∀ {l : list A} {a} (Pa : p a), (f a Pa) ∈ dmap p f l → a ∈ l
+:= sorry
+/-
+| []     := take a Pa Pinnil, by contradiction
+| (b::l) := take a Pa Pmap,
+              decidable.rec_on (h b)
+              (λ Pb, begin
+                rewrite (dmap_cons_of_pos Pb) at Pmap,
+                rewrite mem_cons_iff at Pmap,
+                rewrite mem_cons_iff,
+                apply (or_of_or_of_imp_of_imp Pmap),
+                  apply Pdi,
+                  apply mem_of_dinj_of_mem_dmap Pa
+              end)
+              (λ nPb, begin
+                 rewrite (dmap_cons_of_neg nPb) at Pmap,
+                 apply mem_cons_of_mem,
+                 exact mem_of_dinj_of_mem_dmap Pa Pmap
+              end)
+-/
+
+lemma not_mem_dmap_of_dinj_of_not_mem (Pdi : dinj p f) {l : list A} {a} (Pa : p a) :
+  a ∉ l → (f a Pa) ∉ dmap p f l :=
+not.mto (mem_of_dinj_of_mem_dmap Pdi Pa)
+
+end dmap
+
+/-
+section
+open equiv
+definition list_equiv_of_equiv {A B : Type} : A ≃ B → list A ≃ list B
+| (mk f g l r) :=
+  mk (map f) (map g)
+   begin intros, rewrite [map_map, id_of_left_inverse l, map_id], try reflexivity end
+   begin intros, rewrite [map_map, id_of_right_inverse r, map_id], try reflexivity end
+
+private definition to_nat : list nat → nat
+| []      := 0
+| (x::xs) := succ (mkpair (to_nat xs) x)
+
+open prod.ops
+
+private definition of_nat.F : Π (n : nat), (Π m, m < n → list nat) → list nat
+| 0        f := []
+| (succ n) f := (unpair n).2 :: f (unpair n).1 (unpair_lt n)
+
+private definition of_nat : nat → list nat :=
+well_founded.fix of_nat.F
+
+private lemma of_nat_zero : of_nat 0 = [] :=
+well_founded.fix_eq of_nat.F 0
+
+private lemma of_nat_succ (n : nat)
+      : of_nat (succ n) = (unpair n).2 :: of_nat (unpair n).1 :=
+well_founded.fix_eq of_nat.F (succ n)
+
+private lemma to_nat_of_nat (n : nat) : to_nat (of_nat n) = n :=
+nat.case_strong_induction_on n
+ _
+ (λ n ih,
+  begin
+    rewrite of_nat_succ, unfold to_nat,
+    have to_nat (of_nat (unpair n).1) = (unpair n).1, from ih _ (le_of_lt_succ (unpair_lt n)),
+    rewrite this, rewrite mkpair_unpair
+  end)
+
+private lemma of_nat_to_nat : ∀ (l : list nat), of_nat (to_nat l) = l
+| []      := rfl
+| (x::xs) := begin unfold to_nat, rewrite of_nat_succ, rewrite *unpair_mkpair, esimp, congruence, apply of_nat_to_nat end
+
+definition list_nat_equiv_nat : list nat ≃ nat :=
+mk to_nat of_nat of_nat_to_nat to_nat_of_nat
+
+definition list_equiv_self_of_equiv_nat {A : Type} : A ≃ nat → list A ≃ A :=
+suppose A ≃ nat, calc
+  list A ≃ list nat : list_equiv_of_equiv this
+     ... ≃ nat      : list_nat_equiv_nat
+     ... ≃ A        : this
+end
+-/
+
+end list
+
+attribute list.decidable_any [instance]
+attribute list.decidable_all [instance]

old_library/data/list/default.lean

@@ -0,0 +1,6 @@
+/-
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+-/
+import .basic .comb .set .perm .as_type

old_library/data/list/list.md

@@ -0,0 +1,10 @@
+data.list
+=========
+
+List of elements of a fixed type. By default, `import list` imports everything here.
+
+[basic](basic.lean) : basic operations and properties
+[comb](comb.lean) : combinators and list constructions
+[set](set.lean) : set-like operations (these support the finset construction)
+[perm](perm.lean) : equivalence up to permutation (these support the finset construction)
+[as_type](as_type.lean) : treats a list as a type

old_library/data/list/perm.lean

@@ -0,0 +1,931 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+
+List permutations.
+-/
+import data.list.basic data.list.set
+open list setoid nat binary
+
+variables {A B : Type}
+
+inductive perm : list A → list A → Prop :=
+| nil   : perm [] []
+| skip  : Π (x : A) {l₁ l₂ : list A}, perm l₁ l₂ → perm (x::l₁) (x::l₂)
+| swap  : Π (x y : A) (l : list A), perm (y::x::l) (x::y::l)
+| trans : Π {l₁ l₂ l₃ : list A}, perm l₁ l₂ → perm l₂ l₃ → perm l₁ l₃
+
+namespace perm
+infix ~ := perm
+theorem eq_nil_of_perm_nil {l₁ : list A} (p : [] ~ l₁) : l₁ = [] :=
+sorry
+/-
+have gen : ∀ (l₂ : list A) (p : l₂ ~ l₁), l₂ = [] → l₁ = [], from
+  take l₂ p, perm.induction_on p
+    (λ h, h)
+    (by contradiction)
+    (by contradiction)
+    (λ l₁ l₂ l₃ p₁ p₂ r₁ r₂ e, r₂ (r₁ e)),
+gen [] p rfl
+-/
+
+theorem not_perm_nil_cons (x : A) (l : list A) : ¬ [] ~ (x::l) :=
+sorry
+/-
+have gen : ∀ (l₁ l₂ : list A) (p : l₁ ~ l₂), l₁ = [] → l₂ = (x::l) → false, from
+  take l₁ l₂ p, perm.induction_on p
+    (by contradiction)
+    (by contradiction)
+    (by contradiction)
+    (λ l₁ l₂ l₃ p₁ p₂ r₁ r₂ e₁ e₂,
+      begin
+        rewrite [e₂ at *, e₁ at *],
+        have e₃ : l₂ = [], from eq_nil_of_perm_nil p₁,
+        exact (r₂ e₃ rfl)
+      end),
+assume p, gen [] (x::l) p rfl rfl
+-/
+
+attribute [refl]
+protected theorem refl : ∀ (l : list A), l ~ l
+| []      := nil
+| (x::xs) := skip x (refl xs)
+
+attribute [symm]
+protected theorem symm : ∀ {l₁ l₂ : list A}, l₁ ~ l₂ → l₂ ~ l₁ :=
+take l₁ l₂ p, perm.induction_on p
+  nil
+  (λ x l₁ l₂ p₁ r₁, skip x r₁)
+  (λ x y l, swap y x l)
+  (λ l₁ l₂ l₃ p₁ p₂ r₁ r₂, trans r₂ r₁)
+
+attribute perm.trans [trans]
+
+theorem eqv (A : Type) : equivalence (@perm A) :=
+mk_equivalence (@perm A) (@perm.refl A) (@perm.symm A) (@perm.trans A)
+
+attribute [instance]
+protected definition is_setoid (A : Type) : setoid (list A) :=
+setoid.mk (@perm A) (perm.eqv A)
+
+theorem mem_perm {a : A} {l₁ l₂ : list A} : l₁ ~ l₂ → a ∈ l₁ → a ∈ l₂ :=
+sorry
+/-
+assume p, perm.induction_on p
+  (λ h, h)
+  (λ x l₁ l₂ p₁ r₁ i, or.elim (eq_or_mem_of_mem_cons i)
+    (suppose a = x,  by rewrite this; apply !mem_cons)
+    (suppose a ∈ l₁, or.inr (r₁ this)))
+  (λ x y l ainyxl, or.elim (eq_or_mem_of_mem_cons ainyxl)
+    (suppose a = y, by rewrite this; exact (or.inr !mem_cons))
+    (suppose a ∈ x::l, or.elim (eq_or_mem_of_mem_cons this)
+      (suppose a = x, or.inl this)
+      (suppose a ∈ l, or.inr (or.inr this))))
+  (λ l₁ l₂ l₃ p₁ p₂ r₁ r₂ ainl₁, r₂ (r₁ ainl₁))
+-/
+
+theorem not_mem_perm {a : A} {l₁ l₂ : list A} : l₁ ~ l₂ → a ∉ l₁ → a ∉ l₂ :=
+assume p nainl₁ ainl₂, absurd (mem_perm (perm.symm p) ainl₂) nainl₁
+
+theorem perm_app_left {l₁ l₂ : list A} (t₁ : list A) : l₁ ~ l₂ → (l₁++t₁) ~ (l₂++t₁) :=
+assume p, perm.induction_on p
+  (perm.refl (list.nil ++ t₁))
+  (λ x l₁ l₂ p₁ r₁, skip x r₁)
+  (λ x y l, swap x y _)
+  (λ l₁ l₂ l₃ p₁ p₂ r₁ r₂, trans r₁ r₂)
+
+theorem perm_app_right (l : list A) {t₁ t₂ : list A} : t₁ ~ t₂ → (l++t₁) ~ (l++t₂) :=
+list.induction_on l
+  (λ p, p)
+  (λ x xs r p, skip x (r p))
+
+theorem perm_app {l₁ l₂ t₁ t₂ : list A} : l₁ ~ l₂ → t₁ ~ t₂ → (l₁++t₁) ~ (l₂++t₂) :=
+assume p₁ p₂, trans (perm_app_left t₁ p₁) (perm_app_right l₂ p₂)
+
+theorem perm_app_cons (a : A) {h₁ h₂ t₁ t₂ : list A} : h₁ ~ h₂ → t₁ ~ t₂ → (h₁ ++ (a::t₁)) ~ (h₂ ++ (a::t₂)) :=
+assume p₁ p₂, perm_app p₁ (skip a p₂)
+
+theorem perm_cons_app (a : A) : ∀ (l : list A), (a::l) ~ (l ++ [a])
+| []      := perm.refl _
+| (x::xs) := calc
+  a::x::xs ~ x::a::xs     : swap x a xs
+       ... ~ x::(xs++[a]) : skip x (perm_cons_app xs)
+
+attribute [simp]
+theorem perm_cons_app_simp (a : A) : ∀ (l : list A), (l ++ [a]) ~ (a::l) :=
+take l, perm.symm (perm_cons_app a l)
+
+attribute [simp]
+theorem perm_app_comm {l₁ l₂ : list A} : (l₁++l₂) ~ (l₂++l₁) :=
+sorry
+/-
+list.induction_on l₁
+  (by rewrite [append_nil_right, append_nil_left])
+  (λ a t r, calc
+    a::(t++l₂) ~ a::(l₂++t)   : skip a r
+          ...  ~ l₂++t++[a]   : !perm_cons_app
+          ...  = l₂++(t++[a]) : !append.assoc
+          ...  ~ l₂++(a::t)   : perm_app_right l₂ (perm.symm (perm_cons_app a t)))
+-/
+
+theorem length_eq_length_of_perm {l₁ l₂ : list A} : l₁ ~ l₂ → length l₁ = length l₂ :=
+sorry
+/-
+assume p, perm.induction_on p
+  rfl
+  (λ x l₁ l₂ p r, by rewrite [*length_cons, r])
+  (λ x y l, by rewrite *length_cons)
+  (λ l₁ l₂ l₃ p₁ p₂ r₁ r₂, eq.trans r₁ r₂)
+-/
+
+theorem eq_singleton_of_perm_inv (a : A) {l : list A} : [a] ~ l → l = [a] :=
+sorry
+/-
+have gen : ∀ l₂, perm l₂ l → l₂ = [a] → l = [a], from
+  take l₂, assume p, perm.induction_on p
+    (λ e, e)
+    (λ x l₁ l₂ p r e,
+      begin
+        injection e with e₁ e₂,
+        rewrite [e₁, e₂ at p],
+        have h₁ : l₂ = [], from eq_nil_of_perm_nil p,
+        substvars
+      end)
+    (λ x y l e, by injection e; contradiction)
+    (λ l₁ l₂ l₃ p₁ p₂ r₁ r₂ e, r₂ (r₁ e)),
+assume p, gen [a] p rfl
+-/
+
+theorem eq_singleton_of_perm (a b : A) : [a] ~ [b] → a = b :=
+sorry
+/-
+assume p,
+begin
+  injection eq_singleton_of_perm_inv a p with e₁,
+  rewrite e₁
+end
+-/
+
+theorem perm_rev : ∀ (l : list A), l ~ (reverse l)
+:= sorry
+/-
+| []      := nil
+| (x::xs) := calc
+  x::xs ~ xs++[x]           : perm_cons_app x xs
+    ... ~ reverse xs ++ [x] : perm_app_left [x] (perm_rev xs)
+    ... = reverse (x::xs)   : by rewrite [reverse_cons, concat_eq_append]
+-/
+
+attribute [simp]
+theorem perm_rev_simp : ∀ (l : list A), (reverse l) ~ l :=
+take l, perm.symm (perm_rev l)
+
+theorem perm_middle (a : A) (l₁ l₂ : list A) : (a::l₁)++l₂ ~ l₁++(a::l₂) :=
+calc
+  (a::l₁) ++ l₂ = a::(l₁++l₂)   : rfl
+           ...  ~ l₁++l₂++[a]   : perm_cons_app a (l₁ ++ l₂)
+           ...  = l₁++(l₂++[a]) : append.assoc l₁ l₂ [a]
+           ...  ~ l₁++(a::l₂)   : perm_app_right l₁ (perm.symm (perm_cons_app a l₂))
+
+attribute [simp]
+theorem perm_middle_simp (a : A) (l₁ l₂ : list A) : l₁++(a::l₂) ~ (a::l₁)++l₂ :=
+perm.symm $ perm_middle a l₁ l₂
+
+theorem perm_cons_app_cons {l l₁ l₂ : list A} (a : A) : l ~ l₁++l₂ → a::l ~ l₁++(a::l₂) :=
+assume p, calc
+  a::l ~ l++[a]        : perm_cons_app a l
+   ... ~ l₁++l₂++[a]   : perm_app_left [a] p
+   ... = l₁++(l₂++[a]) : append.assoc l₁ l₂ [a]
+   ... ~ l₁++(a::l₂)   : perm_app_right l₁ (perm.symm (perm_cons_app a l₂))
+
+open decidable
+theorem perm_erase [decidable_eq A] {a : A} : ∀ {l : list A}, a ∈ l → l ~ a::(erase a l)
+:= sorry
+/-
+| []     h := absurd h !not_mem_nil
+| (x::t) h :=
+  by_cases
+    (assume aeqx  : a = x, by rewrite [aeqx, erase_cons_head])
+    (assume naeqx : a ≠ x,
+      have aint : a ∈ t,             from mem_of_ne_of_mem naeqx h,
+      have aux : t ~ a :: erase a t, from perm_erase aint,
+      calc x::t ~ x::a::(erase a t)   : skip x aux
+            ... ~ a::x::(erase a t)   : !swap
+            ... = a::(erase a (x::t)) : by rewrite [!erase_cons_tail naeqx])
+-/
+
+attribute [congr]
+theorem erase_perm_erase_of_perm [decidable_eq A] (a : A) {l₁ l₂ : list A} : l₁ ~ l₂ → erase a l₁ ~ erase a l₂ :=
+sorry
+/-
+assume p, perm.induction_on p
+  nil
+  (λ x t₁ t₂ p r,
+    by_cases
+      (assume aeqx  : a = x, by rewrite [aeqx, *erase_cons_head]; exact p)
+      (assume naeqx : a ≠ x, by rewrite [*erase_cons_tail _ naeqx]; exact (skip x r)))
+  (λ x y l,
+    by_cases
+      (assume aeqx : a = x,
+        by_cases
+          (assume aeqy  : a = y, by rewrite [-aeqx, -aeqy])
+          (assume naeqy : a ≠ y, by rewrite [-aeqx, erase_cons_tail _ naeqy, *erase_cons_head]))
+      (assume naeqx : a ≠ x,
+        by_cases
+          (assume aeqy  : a = y, by rewrite [-aeqy, erase_cons_tail _ naeqx, *erase_cons_head])
+          (assume naeqy : a ≠ y, by rewrite[erase_cons_tail _ naeqx, *erase_cons_tail _ naeqy, erase_cons_tail _ naeqx];
+                                    exact !swap)))
+  (λ l₁ l₂ l₃ p₁ p₂ r₁ r₂, trans r₁ r₂)
+-/
+
+theorem perm_induction_on {P : list A → list A → Prop} {l₁ l₂ : list A} (p : l₁ ~ l₂)
+   (h₁ : P [] [])
+   (h₂ : ∀ x l₁ l₂, l₁ ~ l₂ → P l₁ l₂ → P (x::l₁) (x::l₂))
+   (h₃ : ∀ x y l₁ l₂, l₁ ~ l₂ → P l₁ l₂ → P (y::x::l₁) (x::y::l₂))
+   (h₄ : ∀ l₁ l₂ l₃, l₁ ~ l₂ → l₂ ~ l₃ → P l₁ l₂ → P l₂ l₃ → P l₁ l₃)
+   : P l₁ l₂ :=
+have P_refl : ∀ l, P l l
+  | []      := h₁
+  | (x::xs) := h₂ x xs xs (perm.refl xs) (P_refl xs),
+perm.induction_on p h₁ h₂ (λ x y l, h₃ x y l l (perm.refl l) (P_refl l)) h₄
+
+theorem xswap {l₁ l₂ : list A} (x y : A) : l₁ ~ l₂ → x::y::l₁ ~ y::x::l₂ :=
+assume p, calc
+  x::y::l₁  ~  y::x::l₁  : swap y x l₁
+        ... ~  y::x::l₂  : skip y (skip x p)
+
+attribute [congr]
+theorem perm_map (f : A → B) {l₁ l₂ : list A} : l₁ ~ l₂ → map f l₁ ~ map f l₂ :=
+assume p, perm_induction_on p
+  nil
+  (λ x l₁ l₂ p r, skip (f x) r)
+  (λ x y l₁ l₂ p r, xswap (f y) (f x) r)
+  (λ l₁ l₂ l₃ p₁ p₂ r₁ r₂, trans r₁ r₂)
+
+lemma perm_of_qeq {a : A} {l₁ l₂ : list A} : l₁≈a|l₂ → l₁~a::l₂ :=
+assume q, qeq.induction_on q
+  (λ h, perm.refl (a :: h))
+  (λ b t₁ t₂ q₁ r₁, calc
+     b::t₂ ~ b::a::t₁ : skip b r₁
+       ... ~ a::b::t₁ : swap a b t₁)
+
+/- permutation is decidable if A has decidable equality -/
+section dec
+open decidable
+variable [Ha : decidable_eq A]
+include Ha
+
+definition decidable_perm_aux : ∀ (n : nat) (l₁ l₂ : list A), length l₁ = n → length l₂ = n → decidable (l₁ ~ l₂)
+:= sorry
+/-
+| 0     l₁      l₂ H₁ H₂ :=
+  have l₁n : l₁ = [], from eq_nil_of_length_eq_zero H₁,
+  have l₂n : l₂ = [], from eq_nil_of_length_eq_zero H₂,
+  by rewrite [l₁n, l₂n]; exact (inl perm.nil)
+| (n+1) (x::t₁) l₂ H₁ H₂ :=
+  by_cases
+    (assume xinl₂ : x ∈ l₂,
+      let t₂ : list A := erase x l₂ in
+      have len_t₁ : length t₁ = n,         begin injection H₁ with e, exact e end,
+      have length t₂ = pred (length l₂), from length_erase_of_mem xinl₂,
+      have length t₂ = n,                by rewrite [this, H₂],
+      match decidable_perm_aux n t₁ t₂ len_t₁ this with
+      | inl p  := inl (calc
+          x::t₁ ~ x::(erase x l₂) : skip x p
+           ...  ~ l₂              : perm.symm (perm_erase xinl₂))
+      | inr np := inr (λ p : x::t₁ ~ l₂,
+        have erase x (x::t₁) ~ erase x l₂, from erase_perm_erase_of_perm x p,
+        have t₁ ~ erase x l₂, by rewrite [erase_cons_head at this]; exact this,
+        absurd this np)
+      end)
+    (assume nxinl₂ : x ∉ l₂,
+      inr (λ p : x::t₁ ~ l₂, absurd (mem_perm p !mem_cons) nxinl₂))
+-/
+
+attribute [instance]
+definition decidable_perm : ∀ (l₁ l₂ : list A), decidable (l₁ ~ l₂) :=
+λ l₁ l₂,
+by_cases
+  (assume eql : length l₁ = length l₂,
+    decidable_perm_aux (length l₂) l₁ l₂ eql rfl)
+  (assume neql : length l₁ ≠ length l₂,
+    ff (λ p : l₁ ~ l₂, absurd (length_eq_length_of_perm p) neql))
+end dec
+
+-- Auxiliary theorem for performing cases-analysis on l₂.
+-- We use it to prove perm_inv_core.
+private theorem discr {P : Prop} {a b : A} {l₁ l₂ l₃ : list A} :
+    a::l₁ = l₂++(b::l₃)                    →
+    (l₂ = [] → a = b → l₁ = l₃ → P)        →
+    (∀ t, l₂ = a::t → l₁ = t++(b::l₃) → P) → P :=
+sorry
+/-
+match l₂ with
+| []   := λ e h₁ h₂, by injection e with e₁ e₂; exact h₁ rfl e₁ e₂
+| h::t := λ e h₁ h₂,
+  begin
+    injection e with e₁ e₂,
+    rewrite e₁ at h₂,
+    exact h₂ t rfl e₂
+  end
+end
+-/
+-- Auxiliary theorem for performing cases-analysis on l₂.
+-- We use it to prove perm_inv_core.
+private theorem discr₂ {P : Prop} {a b c : A} {l₁ l₂ l₃ : list A} :
+    a::b::l₁ = l₂++(c::l₃)                     →
+    (l₂ = [] → l₃ = b::l₁ → a = c → P)         →
+    (l₂ = [a] → b = c → l₁ = l₃ → P)           →
+    (∀ t, l₂ = a::b::t → l₁ = t++(c::l₃) → P)  → P :=
+sorry
+/-
+match l₂ with
+| []   := λ e H₁ H₂ H₃,
+  begin
+    injection e with a_eq_c b_l₁_eq_l₃,
+    exact H₁ rfl (eq.symm b_l₁_eq_l₃) a_eq_c
+  end
+| [h₁] := λ e H₁ H₂ H₃,
+  begin
+    rewrite [append_cons at e, append_nil_left at e],
+    injection e  with a_eq_h₁ b_eq_c l₁_eq_l₃,
+    rewrite [a_eq_h₁ at H₂, b_eq_c at H₂, l₁_eq_l₃ at H₂],
+    exact H₂ rfl rfl rfl
+  end
+| h₁::h₂::t₂ := λ e H₁ H₂ H₃,
+  begin
+    injection e with a_eq_h₁ b_eq_h₂ l₁_eq,
+    rewrite [a_eq_h₁ at H₃, b_eq_h₂ at H₃],
+    exact H₃ t₂ rfl l₁_eq
+  end
+end
+-/
+
+/- permutation inversion -/
+theorem perm_inv_core {l₁ l₂ : list A} (p' : l₁ ~ l₂) : ∀ {a s₁ s₂}, l₁≈a|s₁ → l₂≈a|s₂ → s₁ ~ s₂ :=
+sorry
+/-
+perm_induction_on p'
+  (λ a s₁ s₂ e₁ e₂,
+    have innil : a ∈ [], from mem_head_of_qeq e₁,
+    absurd innil !not_mem_nil)
+  (λ x t₁ t₂ p (r : ∀{a s₁ s₂}, t₁≈a|s₁ → t₂≈a|s₂ → s₁ ~ s₂) a s₁ s₂ e₁ e₂,
+    obtain (s₁₁ s₁₂ : list A) (C₁₁ : s₁ = s₁₁ ++ s₁₂) (C₁₂ : x::t₁ = s₁₁++(a::s₁₂)), from qeq_split e₁,
+    obtain (s₂₁ s₂₂ : list A) (C₂₁ : s₂ = s₂₁ ++ s₂₂) (C₂₂ : x::t₂ = s₂₁++(a::s₂₂)), from qeq_split e₂,
+    discr C₁₂
+      (λ (s₁₁_eq : s₁₁ = []) (x_eq_a : x = a) (t₁_eq : t₁ = s₁₂),
+        have s₁_p : s₁ ~ t₂, from calc
+            s₁  = s₁₁ ++ s₁₂ : C₁₁
+            ... = t₁         : by rewrite [-t₁_eq, s₁₁_eq, append_nil_left]
+            ... ~ t₂         : p,
+        discr C₂₂
+          (λ (s₂₁_eq : s₂₁ = []) (x_eq_a : x = a) (t₂_eq: t₂ = s₂₂),
+            proof calc
+              s₁  ~ t₂         : s₁_p
+              ... = s₂₁ ++ s₂₂ : by rewrite [-t₂_eq, s₂₁_eq, append_nil_left]
+              ... = s₂         : by rewrite C₂₁
+            qed)
+          (λ (ts₂₁ : list A) (s₂₁_eq : s₂₁ = x::ts₂₁) (t₂_eq : t₂ = ts₂₁++(a::s₂₂)),
+            proof calc
+              s₁  ~ t₂             : s₁_p
+              ... = ts₂₁++(a::s₂₂) : t₂_eq
+              ... ~ (a::ts₂₁)++s₂₂ : perm.symm !perm_middle
+              ... = s₂₁ ++ s₂₂     : by rewrite [-x_eq_a, -s₂₁_eq]
+              ... = s₂             : by rewrite C₂₁
+            qed))
+      (λ (ts₁₁ : list A) (s₁₁_eq : s₁₁ = x::ts₁₁) (t₁_eq : t₁ = ts₁₁++(a::s₁₂)),
+        have t₁_qeq : t₁ ≈ a|(ts₁₁++s₁₂), by rewrite t₁_eq; exact !qeq_app,
+        have s₁_eq : s₁ = x::(ts₁₁++s₁₂), from calc
+          s₁  = s₁₁ ++ s₁₂       : C₁₁
+          ... = x::(ts₁₁++ s₁₂)  : by rewrite s₁₁_eq,
+        discr C₂₂
+          (λ (s₂₁_eq : s₂₁ = []) (x_eq_a : x = a) (t₂_eq: t₂ = s₂₂),
+            proof calc
+              s₁  = a::(ts₁₁++s₁₂) : by rewrite [s₁_eq, x_eq_a]
+              ... ~ ts₁₁++(a::s₁₂) : !perm_middle
+              ... = t₁             : eq.symm t₁_eq
+              ... ~ t₂             : p
+              ... = s₂             : by rewrite [t₂_eq, C₂₁, s₂₁_eq, append_nil_left]
+            qed)
+          (λ (ts₂₁ : list A) (s₂₁_eq : s₂₁ = x::ts₂₁) (t₂_eq : t₂ = ts₂₁++(a::s₂₂)),
+            have t₂_qeq : t₂ ≈ a|(ts₂₁++s₂₂), by rewrite t₂_eq; exact !qeq_app,
+            proof calc
+              s₁  = x::(ts₁₁++s₁₂) : s₁_eq
+              ... ~ x::(ts₂₁++s₂₂) : skip x (r t₁_qeq t₂_qeq)
+              ... = s₂             : by rewrite [-append_cons, -s₂₁_eq, C₂₁]
+            qed)))
+  (λ x y t₁ t₂ p (r : ∀{a s₁ s₂}, t₁≈a|s₁ → t₂≈a|s₂ → s₁ ~ s₂) a s₁ s₂ e₁ e₂,
+    obtain (s₁₁ s₁₂ : list A) (C₁₁ : s₁ = s₁₁ ++ s₁₂) (C₁₂ : y::x::t₁ = s₁₁++(a::s₁₂)), from qeq_split e₁,
+    obtain (s₂₁ s₂₂ : list A) (C₂₁ : s₂ = s₂₁ ++ s₂₂) (C₂₂ : x::y::t₂ = s₂₁++(a::s₂₂)), from qeq_split e₂,
+    discr₂ C₁₂
+      (λ (s₁₁_eq : s₁₁ = [])  (s₁₂_eq : s₁₂ = x::t₁) (y_eq_a : y = a),
+        have s₁_p : s₁ ~ x::t₂, from calc
+            s₁  = s₁₁ ++ s₁₂ : C₁₁
+            ... = x::t₁      : by rewrite [s₁₂_eq, s₁₁_eq, append_nil_left]
+            ... ~ x::t₂      : skip x p,
+        discr₂ C₂₂
+          (λ (s₂₁_eq : s₂₁ = [])  (s₂₂_eq : s₂₂ = y::t₂) (x_eq_a : x = a),
+            proof calc
+              s₁  ~ x::t₂      : s₁_p
+              ... = s₂₁ ++ s₂₂ : by rewrite [x_eq_a, -y_eq_a, -s₂₂_eq, s₂₁_eq, append_nil_left]
+              ... = s₂         : by rewrite C₂₁
+            qed)
+          (λ (s₂₁_eq : s₂₁ = [x]) (y_eq_a : y = a) (t₂_eq : t₂ = s₂₂),
+            proof calc
+              s₁  ~ x::t₂      : s₁_p
+              ... = s₂₁ ++ s₂₂ : by rewrite [t₂_eq, s₂₁_eq, append_cons]
+              ... = s₂         : by rewrite C₂₁
+            qed)
+          (λ (ts₂₁ : list A) (s₂₁_eq : s₂₁ = x::y::ts₂₁) (t₂_eq : t₂ = ts₂₁++(a::s₂₂)),
+            proof calc
+              s₁  ~ x::t₂               : s₁_p
+              ... = x::(ts₂₁++(y::s₂₂)) : by rewrite [t₂_eq, -y_eq_a]
+              ... ~ x::y::(ts₂₁++s₂₂)   : perm.symm (skip x (perm_middle _ _ _)) -- !perm_middle
+              ... = s₂₁ ++ s₂₂          : by rewrite [s₂₁_eq, append_cons]
+              ... = s₂                  : by rewrite C₂₁
+            qed))
+      (λ (s₁₁_eq : s₁₁ = [y]) (x_eq_a : x = a) (t₁_eq : t₁ = s₁₂),
+        have s₁_p : s₁ ~ y::t₂, from calc
+             s₁  = y::t₁ : by rewrite [C₁₁, s₁₁_eq, t₁_eq]
+             ... ~ y::t₂ : skip y p,
+        discr₂ C₂₂
+          (λ (s₂₁_eq : s₂₁ = [])  (s₂₂_eq : s₂₂ = y::t₂) (x_eq_a : x = a),
+            proof calc
+              s₁  ~ y::t₂      : s₁_p
+              ... = s₂₁ ++ s₂₂ : by rewrite [s₂₁_eq, s₂₂_eq]
+              ... = s₂         : by rewrite C₂₁
+            qed)
+          (λ (s₂₁_eq : s₂₁ = [x]) (y_eq_a : y = a) (t₂_eq : t₂ = s₂₂),
+            proof calc
+              s₁  ~ y::t₂      : s₁_p
+              ... = s₂₁ ++ s₂₂ : by rewrite [s₂₁_eq, t₂_eq, y_eq_a, -x_eq_a]
+              ... = s₂         : by rewrite C₂₁
+            qed)
+          (λ (ts₂₁ : list A) (s₂₁_eq : s₂₁ = x::y::ts₂₁) (t₂_eq : t₂ = ts₂₁++(a::s₂₂)),
+            proof calc
+              s₁  ~ y::t₂               : s₁_p
+              ... = y::(ts₂₁++(x::s₂₂)) : by rewrite [t₂_eq, -x_eq_a]
+              ... ~ y::x::(ts₂₁++s₂₂)   : perm.symm (skip y (perm_middle _ _ _))
+              ... ~ x::y::(ts₂₁++s₂₂)   : !swap
+              ... = s₂₁ ++ s₂₂          : by rewrite [s₂₁_eq]
+              ... = s₂                  : by rewrite C₂₁
+            qed))
+      (λ (ts₁₁ : list A) (s₁₁_eq : s₁₁ = y::x::ts₁₁) (t₁_eq : t₁ = ts₁₁++(a::s₁₂)),
+        have s₁_eq  : s₁ = y::x::(ts₁₁++s₁₂), by rewrite [C₁₁, s₁₁_eq],
+        discr₂ C₂₂
+          (λ (s₂₁_eq : s₂₁ = [])  (s₂₂_eq : s₂₂ = y::t₂) (x_eq_a : x = a),
+            proof calc
+              s₁  = y::a::(ts₁₁++s₁₂)   : by rewrite [s₁_eq, x_eq_a]
+              ... ~ y::(ts₁₁++(a::s₁₂)) : skip y !perm_middle
+              ... = y::t₁               : by rewrite t₁_eq
+              ... ~ y::t₂               : skip y p
+              ... = s₂₁ ++ s₂₂          : by rewrite [s₂₁_eq, s₂₂_eq]
+              ... = s₂                  : by rewrite C₂₁
+            qed)
+          (λ (s₂₁_eq : s₂₁ = [x]) (y_eq_a : y = a) (t₂_eq : t₂ = s₂₂),
+            proof calc
+              s₁  = y::x::(ts₁₁++s₁₂)   : by rewrite s₁_eq
+              ... ~ x::y::(ts₁₁++s₁₂)   : !swap
+              ... = x::a::(ts₁₁++s₁₂)   : by rewrite y_eq_a
+              ... ~ x::(ts₁₁++(a::s₁₂)) : skip x (perm_middle _ _ _)
+              ... = x::t₁               : by rewrite t₁_eq
+              ... ~ x::t₂               : skip x p
+              ... = s₂₁ ++ s₂₂          : by rewrite [t₂_eq, s₂₁_eq]
+              ... = s₂                  : by rewrite C₂₁
+            qed)
+          (λ (ts₂₁ : list A) (s₂₁_eq : s₂₁ = x::y::ts₂₁) (t₂_eq : t₂ = ts₂₁++(a::s₂₂)),
+            have t₁_qeq : t₁ ≈ a|(ts₁₁++s₁₂),    by rewrite t₁_eq; exact !qeq_app,
+            have t₂_qeq : t₂ ≈ a|(ts₂₁++s₂₂),    by rewrite t₂_eq; exact !qeq_app,
+            have p_aux  : ts₁₁++s₁₂ ~ ts₂₁++s₂₂, from r t₁_qeq t₂_qeq,
+            proof calc
+              s₁  = y::x::(ts₁₁++s₁₂)   : by rewrite s₁_eq
+              ... ~ y::x::(ts₂₁++s₂₂)   : skip y (skip x p_aux)
+              ... ~ x::y::(ts₂₁++s₂₂)   : !swap
+              ... = s₂₁ ++ s₂₂          : by rewrite s₂₁_eq
+              ... = s₂                  : by rewrite C₂₁
+            qed)))
+  (λ t₁ t₂ t₃ p₁ p₂
+     (r₁ : ∀{a s₁ s₂}, t₁ ≈ a|s₁ → t₂≈a|s₂ → s₁ ~ s₂)
+     (r₂ : ∀{a s₁ s₂}, t₂ ≈ a|s₁ → t₃≈a|s₂ → s₁ ~ s₂)
+     a s₁ s₂ e₁ e₂,
+    have a ∈ t₁, from mem_head_of_qeq e₁,
+    have a ∈ t₂, from mem_perm p₁ this,
+    obtain (t₂' : list A) (e₂' : t₂≈a|t₂'), from qeq_of_mem this,
+    calc s₁  ~ t₂' : r₁ e₁ e₂'
+        ...  ~ s₂  : r₂ e₂' e₂)
+-/
+
+theorem perm_cons_inv {a : A} {l₁ l₂ : list A} : a::l₁ ~ a::l₂ → l₁ ~ l₂ :=
+assume p, perm_inv_core p (qeq.qhead a l₁) (qeq.qhead a l₂)
+
+theorem perm_app_inv {a : A} {l₁ l₂ l₃ l₄ : list A} : l₁++(a::l₂) ~ l₃++(a::l₄) → l₁++l₂ ~ l₃++l₄ :=
+assume p : l₁++(a::l₂) ~ l₃++(a::l₄),
+  have p' : a::(l₁++l₂) ~ a::(l₃++l₄), from calc
+    a::(l₁++l₂) ~ l₁++(a::l₂) : perm_middle a l₁ l₂
+          ...   ~ l₃++(a::l₄) : p
+          ...   ~ a::(l₃++l₄) : perm.symm (perm_middle a l₃ l₄),
+  perm_cons_inv p'
+
+section foldl
+  variables {f : B → A → B} {l₁ l₂ : list A}
+  variable rcomm : right_commutative f
+  include  rcomm
+
+  theorem foldl_eq_of_perm : l₁ ~ l₂ → ∀ b, foldl f b l₁ = foldl f b l₂ :=
+  sorry
+  /-
+  assume p, perm_induction_on p
+    (λ b, by rewrite *foldl_nil)
+    (λ x t₁ t₂ p r b, calc
+       foldl f b (x::t₁) = foldl f (f b x) t₁ : !foldl_cons
+               ...       = foldl f (f b x) t₂ : by rewrite (r (f b x))
+               ...       = foldl f b (x::t₂)  : eq.symm !foldl_cons)
+    (λ x y t₁ t₂ p r b, calc
+       foldl f b (y :: x :: t₁) = foldl f (f (f b y) x) t₁ : by rewrite foldl_cons
+                     ...        = foldl f (f (f b x) y) t₁ : by rewrite rcomm
+                     ...        = foldl f (f (f b x) y) t₂ : r (f (f b x) y)
+                     ...        = foldl f b (x :: y :: t₂) : by rewrite foldl_cons)
+    (λ t₁ t₂ t₃ p₁ p₂ r₁ r₂ b, eq.trans (r₁ b) (r₂ b))
+  -/
+end foldl
+
+section foldr
+  variables {f : A → B → B} {l₁ l₂ : list A}
+  variable lcomm : left_commutative f
+  include  lcomm
+
+  theorem foldr_eq_of_perm : l₁ ~ l₂ → ∀ b, foldr f b l₁ = foldr f b l₂ :=
+  sorry
+  /-
+  assume p, perm_induction_on p
+    (λ b, by rewrite *foldl_nil)
+    (λ x t₁ t₂ p r b, calc
+       foldr f b (x::t₁) = f x (foldr f b t₁) : !foldr_cons
+               ...       = f x (foldr f b t₂) : by rewrite [r b]
+               ...       = foldr f b (x::t₂)  : eq.symm !foldr_cons)
+    (λ x y t₁ t₂ p r b, calc
+       foldr f b (y :: x :: t₁) = f y (f x (foldr f b t₁)) : by rewrite foldr_cons
+                  ...           = f x (f y (foldr f b t₁)) : by rewrite lcomm
+                  ...           = f x (f y (foldr f b t₂)) : by rewrite [r b]
+                  ...           = foldr f b (x :: y :: t₂) : by rewrite foldr_cons)
+    (λ t₁ t₂ t₃ p₁ p₂ r₁ r₂ a, eq.trans (r₁ a) (r₂ a))
+  -/
+end foldr
+
+attribute [congr]
+theorem perm_erase_dup_of_perm [H : decidable_eq A] {l₁ l₂ : list A} : l₁ ~ l₂ → erase_dup l₁ ~ erase_dup l₂ :=
+sorry
+/-
+assume p, perm_induction_on p
+  nil
+  (λ x t₁ t₂ p r, by_cases
+    (λ xint₁  : x ∈ t₁,
+      have xint₂ : x ∈ t₂, from mem_of_mem_erase_dup (mem_perm r (mem_erase_dup xint₁)),
+      by rewrite [erase_dup_cons_of_mem xint₁, erase_dup_cons_of_mem xint₂]; exact r)
+    (λ nxint₁ : x ∉ t₁,
+      have nxint₂ : x ∉ t₂, from
+         assume xint₂ : x ∈ t₂, absurd (mem_of_mem_erase_dup (mem_perm (perm.symm r) (mem_erase_dup xint₂))) nxint₁,
+      by rewrite [erase_dup_cons_of_not_mem nxint₂, erase_dup_cons_of_not_mem nxint₁]; exact (skip x r)))
+  (λ y x t₁ t₂ p r, by_cases
+    (λ xinyt₁  : x ∈ y::t₁, by_cases
+      (λ yint₁  : y ∈ t₁,
+        have yint₂  : y ∈ t₂,    from mem_of_mem_erase_dup (mem_perm r (mem_erase_dup yint₁)),
+        have yinxt₂ : y ∈ x::t₂, from or.inr (yint₂),
+        or.elim (eq_or_mem_of_mem_cons xinyt₁)
+          (λ xeqy  : x = y,
+            have xint₂ : x ∈ t₂, by rewrite [-xeqy at yint₂]; exact yint₂,
+            begin
+              rewrite [erase_dup_cons_of_mem xinyt₁, erase_dup_cons_of_mem yinxt₂,
+                       erase_dup_cons_of_mem yint₁, erase_dup_cons_of_mem xint₂],
+              exact r
+            end)
+          (λ xint₁ : x ∈ t₁,
+            have xint₂ : x ∈ t₂, from mem_of_mem_erase_dup (mem_perm r (mem_erase_dup xint₁)),
+            begin
+              rewrite [erase_dup_cons_of_mem xinyt₁, erase_dup_cons_of_mem yinxt₂,
+                       erase_dup_cons_of_mem yint₁, erase_dup_cons_of_mem xint₂],
+              exact r
+            end))
+      (λ nyint₁ : y ∉ t₁,
+        have nyint₂ : y ∉ t₂, from
+          assume yint₂ : y ∈ t₂, absurd (mem_of_mem_erase_dup (mem_perm (perm.symm r) (mem_erase_dup yint₂))) nyint₁,
+        by_cases
+          (λ xeqy  : x = y,
+            have nxint₂ : x ∉ t₂, by rewrite [-xeqy at nyint₂]; exact nyint₂,
+            have yinxt₂ : y ∈ x::t₂, by rewrite [xeqy]; exact !mem_cons,
+            begin
+              rewrite [erase_dup_cons_of_mem xinyt₁, erase_dup_cons_of_mem yinxt₂,
+                       erase_dup_cons_of_not_mem nyint₁, erase_dup_cons_of_not_mem nxint₂, xeqy],
+              exact skip y r
+            end)
+          (λ xney : x ≠ y,
+            have x ∈ t₁, from or_resolve_right xinyt₁ xney,
+            have x ∈ t₂, from mem_of_mem_erase_dup (mem_perm r (mem_erase_dup this)),
+            have y ∉ x::t₂, from
+              suppose y ∈ x::t₂, or.elim (eq_or_mem_of_mem_cons this)
+                (λ h, absurd h (ne.symm xney))
+                (λ h, absurd h nyint₂),
+            begin
+              rewrite [erase_dup_cons_of_mem xinyt₁, erase_dup_cons_of_not_mem `y ∉ x::t₂`,
+                       erase_dup_cons_of_not_mem nyint₁, erase_dup_cons_of_mem `x ∈ t₂`],
+              exact skip y r
+            end)))
+    (λ nxinyt₁ : x ∉ y::t₁,
+      have xney    : x ≠ y,  from ne_of_not_mem_cons nxinyt₁,
+      have nxint₁  : x ∉ t₁, from not_mem_of_not_mem_cons nxinyt₁,
+      have nxint₂  : x ∉ t₂, from
+        assume xint₂ : x ∈ t₂, absurd (mem_of_mem_erase_dup (mem_perm (perm.symm r) (mem_erase_dup xint₂))) nxint₁,
+      by_cases
+        (λ yint₁  : y ∈ t₁,
+          have yinxt₂ : y ∈ x::t₂, from or.inr (mem_of_mem_erase_dup (mem_perm r (mem_erase_dup yint₁))),
+          begin
+            rewrite [erase_dup_cons_of_not_mem nxinyt₁, erase_dup_cons_of_mem yinxt₂,
+                     erase_dup_cons_of_mem yint₁, erase_dup_cons_of_not_mem nxint₂],
+            exact skip x r
+          end)
+        (λ nyint₁ : y ∉ t₁,
+          have nyinxt₂ : y ∉ x::t₂, from
+            assume yinxt₂ : y ∈ x::t₂, or.elim (eq_or_mem_of_mem_cons yinxt₂)
+              (λ h, absurd h (ne.symm xney))
+              (λ h, absurd (mem_of_mem_erase_dup (mem_perm (perm.symm r) (mem_erase_dup h))) nyint₁),
+          begin
+            rewrite [erase_dup_cons_of_not_mem nxinyt₁, erase_dup_cons_of_not_mem nyinxt₂,
+                     erase_dup_cons_of_not_mem nyint₁, erase_dup_cons_of_not_mem nxint₂],
+            exact xswap x y r
+          end)))
+  (λ t₁ t₂ t₃ p₁ p₂ r₁ r₂, trans r₁ r₂)
+-/
+
+section perm_union
+variable [H : decidable_eq A]
+include H
+
+theorem perm_union_left {l₁ l₂ : list A} (t₁ : list A) : l₁ ~ l₂ → (union l₁ t₁) ~ (union l₂ t₁) :=
+sorry
+/-
+assume p, perm.induction_on p
+  (by rewrite [nil_union])
+  (λ x l₁ l₂ p₁ r₁, by_cases
+     (λ xint₁  : x ∈ t₁, by rewrite [*union_cons_of_mem _ xint₁]; exact r₁)
+     (λ nxint₁ : x ∉ t₁, by rewrite [*union_cons_of_not_mem _ nxint₁]; exact (skip _ r₁)))
+  (λ x y l, by_cases
+    (λ yint  : y ∈ t₁, by_cases
+      (λ xint  : x ∈ t₁,
+        by rewrite [*union_cons_of_mem _ xint, *union_cons_of_mem _ yint, *union_cons_of_mem _ xint])
+      (λ nxint : x ∉ t₁,
+        by rewrite [*union_cons_of_mem _ yint, *union_cons_of_not_mem _ nxint, union_cons_of_mem _ yint]))
+    (λ nyint : y ∉ t₁, by_cases
+      (λ xint  : x ∈ t₁,
+        by rewrite [*union_cons_of_mem _ xint, *union_cons_of_not_mem _ nyint, union_cons_of_mem _ xint])
+      (λ nxint : x ∉ t₁,
+        by rewrite [*union_cons_of_not_mem _ nxint, *union_cons_of_not_mem _ nyint, union_cons_of_not_mem _ nxint]; exact !swap)))
+  (λ l₁ l₂ l₃ p₁ p₂ r₁ r₂, trans r₁ r₂)
+-/
+
+theorem perm_union_right (l : list A) {t₁ t₂ : list A} : t₁ ~ t₂ → (union l t₁) ~ (union l t₂) :=
+sorry
+/-
+list.induction_on l
+  (λ p, by rewrite [*union_nil]; exact p)
+  (λ x xs r p, by_cases
+    (λ xint₁  : x ∈ t₁,
+      have xint₂ : x ∈ t₂, from mem_perm p xint₁,
+      by rewrite [union_cons_of_mem _ xint₁, union_cons_of_mem _ xint₂]; exact (r p))
+    (λ nxint₁ : x ∉ t₁,
+      have nxint₂ : x ∉ t₂, from not_mem_perm p nxint₁,
+      by rewrite [union_cons_of_not_mem _ nxint₁, union_cons_of_not_mem _ nxint₂]; exact (skip _ (r p))))
+-/
+
+attribute [congr]
+theorem perm_union {l₁ l₂ t₁ t₂ : list A} : l₁ ~ l₂ → t₁ ~ t₂ → (union l₁ t₁) ~ (union l₂ t₂) :=
+assume p₁ p₂, trans (perm_union_left t₁ p₁) (perm_union_right l₂ p₂)
+end perm_union
+
+section perm_insert
+variable [H : decidable_eq A]
+include H
+
+attribute [congr]
+theorem perm_insert (a : A) {l₁ l₂ : list A} : l₁ ~ l₂ → (insert a l₁) ~ (insert a l₂) :=
+sorry
+/-
+assume p, by_cases
+ (λ ainl₁  : a ∈ l₁,
+   have ainl₂ : a ∈ l₂, from mem_perm p ainl₁,
+   by rewrite [insert_eq_of_mem ainl₁, insert_eq_of_mem ainl₂]; exact p)
+ (λ nainl₁ : a ∉ l₁,
+   have nainl₂ : a ∉ l₂, from not_mem_perm p nainl₁,
+   by rewrite [insert_eq_of_not_mem nainl₁, insert_eq_of_not_mem nainl₂]; exact (skip _ p))
+-/
+end perm_insert
+
+section perm_inter
+variable [H : decidable_eq A]
+include H
+
+theorem perm_inter_left {l₁ l₂ : list A} (t₁ : list A) : l₁ ~ l₂ → (inter l₁ t₁) ~ (inter l₂ t₁) :=
+sorry
+/-
+assume p, perm.induction_on p
+  !perm.refl
+  (λ x l₁ l₂ p₁ r₁, by_cases
+    (λ xint₁  : x ∈ t₁, by rewrite [*inter_cons_of_mem _ xint₁]; exact (skip x r₁))
+    (λ nxint₁ : x ∉ t₁, by rewrite [*inter_cons_of_not_mem _ nxint₁]; exact r₁))
+  (λ x y l, by_cases
+    (λ yint  : y ∈ t₁, by_cases
+      (λ xint  : x ∈ t₁,
+        by rewrite [*inter_cons_of_mem _ xint, *inter_cons_of_mem _ yint, *inter_cons_of_mem _ xint];
+           exact !swap)
+      (λ nxint : x ∉ t₁,
+        by rewrite [*inter_cons_of_mem _ yint, *inter_cons_of_not_mem _ nxint, inter_cons_of_mem _ yint]))
+    (λ nyint : y ∉ t₁, by_cases
+      (λ xint  : x ∈ t₁,
+        by rewrite [*inter_cons_of_mem _ xint, *inter_cons_of_not_mem _ nyint, inter_cons_of_mem _ xint])
+      (λ nxint : x ∉ t₁,
+        by rewrite [*inter_cons_of_not_mem _ nxint, *inter_cons_of_not_mem _ nyint,
+                     inter_cons_of_not_mem _ nxint])))
+  (λ l₁ l₂ l₃ p₁ p₂ r₁ r₂, trans r₁ r₂)
+-/
+
+theorem perm_inter_right (l : list A) {t₁ t₂ : list A} : t₁ ~ t₂ → (inter l t₁) ~ (inter l t₂) :=
+sorry
+/-
+list.induction_on l
+  (λ p, by rewrite [*inter_nil])
+  (λ x xs r p, by_cases
+    (λ xint₁  : x ∈ t₁,
+      have xint₂ : x ∈ t₂, from mem_perm p xint₁,
+      by rewrite [inter_cons_of_mem _ xint₁, inter_cons_of_mem _ xint₂]; exact (skip _ (r p)))
+    (λ nxint₁ : x ∉ t₁,
+      have nxint₂ : x ∉ t₂, from not_mem_perm p nxint₁,
+      by rewrite [inter_cons_of_not_mem _ nxint₁, inter_cons_of_not_mem _ nxint₂]; exact (r p)))
+-/
+attribute [congr]
+theorem perm_inter {l₁ l₂ t₁ t₂ : list A} : l₁ ~ l₂ → t₁ ~ t₂ → (inter l₁ t₁) ~ (inter l₂ t₂) :=
+assume p₁ p₂, trans (perm_inter_left t₁ p₁) (perm_inter_right l₂ p₂)
+end perm_inter
+
+/- extensionality -/
+section ext
+
+theorem perm_ext : ∀ {l₁ l₂ : list A}, nodup l₁ → nodup l₂ → (∀a, a ∈ l₁ ↔ a ∈ l₂) → l₁ ~ l₂
+:= sorry
+/-
+| []       []       d₁ d₂ e := !perm.nil
+| []       (a₂::t₂) d₁ d₂ e := absurd (iff.mpr (e a₂) !mem_cons) (not_mem_nil a₂)
+| (a₁::t₁) []       d₁ d₂ e := absurd (iff.mp (e a₁) !mem_cons) (not_mem_nil a₁)
+| (a₁::t₁) (a₂::t₂) d₁ d₂ e :=
+  have a₁ ∈ a₂::t₂, from iff.mp (e a₁) !mem_cons,
+  have ∃ s₁ s₂, a₂::t₂ = s₁++(a₁::s₂), from mem_split this,
+  obtain (s₁ s₂ : list A) (t₂_eq : a₂::t₂ = s₁++(a₁::s₂)), from this,
+  have dt₂'     : nodup (a₁::(s₁++s₂)), from nodup_head (by rewrite [t₂_eq at d₂]; exact d₂),
+  have eqv      : ∀a, a ∈ t₁ ↔ a ∈ s₁++s₂, from
+    take a, iff.intro
+      (suppose  a ∈ t₁,
+         have a ∈ a₂::t₂,       from iff.mp (e a) (mem_cons_of_mem _ this),
+         have a ∈ s₁++(a₁::s₂), by rewrite [t₂_eq at this]; exact this,
+         or.elim (mem_or_mem_of_mem_append this)
+           (suppose a ∈ s₁, mem_append_left s₂ this)
+           (suppose a ∈ a₁::s₂, or.elim (eq_or_mem_of_mem_cons this)
+             (suppose a = a₁,
+               have a₁ ∉ t₁, from not_mem_of_nodup_cons d₁,
+               by subst a; contradiction)
+             (suppose a ∈ s₂, mem_append_right s₁ this)))
+      (suppose a ∈ s₁ ++ s₂, or.elim (mem_or_mem_of_mem_append this)
+        (suppose a ∈ s₁,
+           have a ∈ a₂::t₂, from by rewrite [t₂_eq]; exact (mem_append_left _ this),
+           have a ∈ a₁::t₁, from iff.mpr (e a) this,
+           or.elim (eq_or_mem_of_mem_cons this)
+             (suppose a = a₁,
+                have a₁ ∉ s₁++s₂, from not_mem_of_nodup_cons dt₂',
+                have a₁ ∉ s₁,     from not_mem_of_not_mem_append_left this,
+                by subst a; contradiction)
+             (suppose a ∈ t₁, this))
+        (suppose a ∈ s₂,
+           have a ∈ a₂::t₂, from by rewrite [t₂_eq]; exact (mem_append_right _ (mem_cons_of_mem _ this)),
+           have a ∈ a₁::t₁, from iff.mpr (e a) this,
+           or.elim (eq_or_mem_of_mem_cons this)
+             (suppose a = a₁,
+               have a₁ ∉ s₁++s₂, from not_mem_of_nodup_cons dt₂',
+               have a₁ ∉ s₂, from not_mem_of_not_mem_append_right this,
+               by subst a; contradiction)
+             (suppose a ∈ t₁, this))),
+  have ds₁s₂ : nodup (s₁++s₂), from nodup_of_nodup_cons dt₂',
+  have nodup t₁, from nodup_of_nodup_cons d₁,
+  calc a₁::t₁ ~ a₁::(s₁++s₂) : skip a₁ (perm_ext this ds₁s₂ eqv)
+         ...  ~ s₁++(a₁::s₂) : !perm_middle
+         ...  = a₂::t₂       : by rewrite t₂_eq
+-/
+end ext
+
+theorem nodup_of_perm_of_nodup {l₁ l₂ : list A} : l₁ ~ l₂ → nodup l₁ → nodup l₂ :=
+sorry
+/-
+assume h, perm.induction_on h
+  (λ h, h)
+  (λ a l₁ l₂ p ih nd,
+    have nodup l₁, from nodup_of_nodup_cons nd,
+    have nodup l₂, from ih this,
+    have a ∉ l₁,   from not_mem_of_nodup_cons nd,
+    have a ∉ l₂,   from suppose a ∈ l₂, absurd (mem_perm (perm.symm p) this) `a ∉ l₁`,
+    nodup_cons `a ∉ l₂` `nodup l₂`)
+  (λ x y l₁ nd,
+    have nodup (x::l₁),    from nodup_of_nodup_cons nd,
+    have nodup l₁,         from nodup_of_nodup_cons this,
+    have x ∉ l₁,           from not_mem_of_nodup_cons `nodup (x::l₁)`,
+    have y ∉ x::l₁,        from not_mem_of_nodup_cons nd,
+    have x ≠ y,            from suppose x = y, begin subst x, exact absurd !mem_cons `y ∉ y::l₁` end,
+    have y ∉ l₁,           from not_mem_of_not_mem_cons `y ∉ x::l₁`,
+    have x ∉ y::l₁,        from not_mem_cons_of_ne_of_not_mem `x ≠ y` `x ∉ l₁`,
+    have nodup (y::l₁),    from nodup_cons `y ∉ l₁` `nodup l₁`,
+    show nodup (x::y::l₁), from nodup_cons `x ∉ y::l₁` `nodup (y::l₁)`)
+  (λ l₁ l₂ l₃ p₁ p₂ ih₁ ih₂ nd, ih₂ (ih₁ nd))
+-/
+
+/- product -/
+section product
+theorem perm_product_left {l₁ l₂ : list A} (t₁ : list B) : l₁ ~ l₂ → (product l₁ t₁) ~ (product l₂ t₁) :=
+sorry
+/-
+assume p : l₁ ~ l₂, perm.induction_on p
+  !perm.refl
+  (λ x l₁ l₂ p r, perm_app (perm.refl (map _ t₁)) r)
+  (λ x y l,
+    let m₁ := map (λ b, (x, b)) t₁ in
+    let m₂ := map (λ b, (y, b)) t₁ in
+    let c  := product l t₁ in
+    calc m₂ ++ (m₁ ++ c) = (m₂ ++ m₁) ++ c  : by rewrite append.assoc
+                     ... ~ (m₁ ++ m₂) ++ c  : perm_app !perm_app_comm !perm.refl
+                     ... =  m₁ ++ (m₂ ++ c) : by rewrite append.assoc)
+  (λ l₁ l₂ l₃ p₁ p₂ r₁ r₂, trans r₁ r₂)
+-/
+
+theorem perm_product_right (l : list A) {t₁ t₂ : list B} : t₁ ~ t₂ → (product l t₁) ~ (product l t₂) :=
+sorry
+/-
+list.induction_on l
+  (λ p, by rewrite [*nil_product])
+  (λ a t r p,
+    perm_app (perm_map _ p) (r p))
+-/
+
+attribute [congr]
+theorem perm_product {l₁ l₂ : list A} {t₁ t₂ : list B} : l₁ ~ l₂ → t₁ ~ t₂ → (product l₁ t₁) ~ (product l₂ t₂) :=
+assume p₁ p₂, trans (perm_product_left t₁ p₁) (perm_product_right l₂ p₂)
+end product
+
+/- filter -/
+attribute [congr]
+theorem perm_filter {l₁ l₂ : list A} {p : A → Prop} [decidable_pred p] :
+  l₁ ~ l₂ → (filter p l₁) ~ (filter p l₂) :=
+sorry
+/-
+assume u, perm.induction_on u
+  perm.nil
+  (take x l₁' l₂',
+    assume u' : l₁' ~ l₂',
+    assume u'' : filter p l₁' ~ filter p l₂',
+    decidable.by_cases
+      (suppose p x, by rewrite [*filter_cons_of_pos _ this]; apply perm.skip; apply u'')
+      (suppose ¬ p x, by rewrite [*filter_cons_of_neg _ this]; apply u''))
+  (take x y l,
+    decidable.by_cases
+      (assume H1 : p x,
+        decidable.by_cases
+          (assume H2 : p y,
+             begin
+               rewrite [filter_cons_of_pos _ H1, *filter_cons_of_pos _ H2, filter_cons_of_pos _ H1],
+               apply perm.swap
+             end)
+          (assume H2 : ¬ p y,
+             by rewrite [filter_cons_of_pos _ H1, *filter_cons_of_neg _ H2, filter_cons_of_pos _ H1]))
+      (assume H1 : ¬ p x,
+        decidable.by_cases
+          (assume H2 : p y,
+             by rewrite [filter_cons_of_neg _ H1, *filter_cons_of_pos _ H2, filter_cons_of_neg _ H1])
+          (assume H2 : ¬ p y,
+             by rewrite [filter_cons_of_neg _ H1, *filter_cons_of_neg _ H2, filter_cons_of_neg _ H1])))
+    (λ l₁ l₂ l₃ p₁ p₂ r₁ r₂, trans r₁ r₂)
+-/
+section count
+variable [decA : decidable_eq A]
+include decA
+
+theorem count_eq_of_perm {l₁ l₂ : list A} : l₁ ~ l₂ → ∀ a, count a l₁ = count a l₂ :=
+sorry
+/-
+suppose l₁ ~ l₂, perm.induction_on this
+  (λ a, rfl)
+  (λ x l₁ l₂ p h a, by rewrite [*count_cons, *h a])
+  (λ x y l a, by_cases
+     (suppose a = x, by_cases
+       (suppose a = y, begin subst x, subst y end)
+       (suppose a ≠ y, begin subst x, rewrite [count_cons_of_ne this, *count_cons_eq, count_cons_of_ne this] end))
+     (suppose a ≠ x, by_cases
+       (suppose a = y, begin subst y, rewrite [count_cons_of_ne this, *count_cons_eq, count_cons_of_ne this] end)
+       (suppose a ≠ y, begin rewrite [count_cons_of_ne `a≠x`, *count_cons_of_ne `a≠y`, count_cons_of_ne `a≠x`] end)))
+  (λ l₁ l₂ l₃ p₁ p₂ h₁ h₂ a, eq.trans (h₁ a) (h₂ a))
+-/
+end count
+end perm

old_library/data/list/set.lean

@@ -0,0 +1,920 @@
+/-
+Copyright (c) 2015 Leonardo de Moura. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+
+Set-like operations on lists
+-/
+import data.list.basic data.list.comb
+open nat function decidable
+
+namespace list
+section erase
+variable {A : Type}
+variable [H : decidable_eq A]
+include H
+
+definition erase (a : A) : list A → list A
+| []     := []
+| (b::l) :=
+  match (H a b) with
+  | (tt e) := l
+  | (ff n) := b :: erase l
+  end
+
+lemma erase_nil (a : A) : erase a [] = [] :=
+rfl
+
+lemma erase_cons_head (a : A) (l : list A) : erase a (a :: l) = l :=
+sorry
+/-
+show match H a a with | inl e := l | inr n := a :: erase a l end = l,
+by rewrite decidable_eq_inl_refl
+-/
+
+lemma erase_cons_tail {a b : A} (l : list A) : a ≠ b → erase a (b::l) = b :: erase a l :=
+sorry
+/-
+assume h : a ≠ b,
+show match H a b with | inl e := l | inr n₁ := b :: erase a l end = b :: erase a l,
+by rewrite (decidable_eq_inr_neg h)
+-/
+
+lemma length_erase_of_mem {a : A} : ∀ {l}, a ∈ l → length (erase a l) = pred (length l)
+:= sorry
+/-
+| []         h := rfl
+| [x]        h := by rewrite [mem_singleton h, erase_cons_head]
+| (x::y::xs) h :=
+  by_cases
+   (suppose a = x, by rewrite [this, erase_cons_head])
+   (suppose a ≠ x,
+    have ainyxs : a ∈ y::xs, from or_resolve_right h this,
+    by rewrite [erase_cons_tail _ this, *length_cons, length_erase_of_mem ainyxs])
+-/
+
+lemma length_erase_of_not_mem {a : A} : ∀ {l}, a ∉ l → length (erase a l) = length l
+:= sorry
+/-
+| []      h   := rfl
+| (x::xs) h   :=
+  have anex   : a ≠ x,  from λ aeqx  : a = x,  absurd (or.inl aeqx) h,
+  have aninxs : a ∉ xs, from λ ainxs : a ∈ xs, absurd (or.inr ainxs) h,
+  by rewrite [erase_cons_tail _ anex, length_cons, length_erase_of_not_mem aninxs]
+-/
+
+lemma erase_append_left {a : A} : ∀ {l₁} (l₂), a ∈ l₁ → erase a (l₁++l₂) = erase a l₁ ++ l₂
+:= sorry
+/-
+| []      l₂  h := absurd h !not_mem_nil
+| (x::xs) l₂  h :=
+  by_cases
+   (λ aeqx : a = x, by rewrite [aeqx, append_cons, *erase_cons_head])
+   (λ anex : a ≠ x,
+    have ainxs : a ∈ xs, from mem_of_ne_of_mem anex h,
+    by rewrite [append_cons, *erase_cons_tail _ anex, erase_append_left l₂ ainxs])
+-/
+
+lemma erase_append_right {a : A} : ∀ {l₁} (l₂), a ∉ l₁ → erase a (l₁++l₂) = l₁ ++ erase a l₂
+:= sorry
+/-
+| []      l₂ h := rfl
+| (x::xs) l₂ h :=
+  by_cases
+   (λ aeqx : a = x, by rewrite aeqx at h; exact (absurd !mem_cons h))
+   (λ anex : a ≠ x,
+    have nainxs : a ∉ xs, from not_mem_of_not_mem_cons h,
+    by rewrite [append_cons, *erase_cons_tail _ anex, erase_append_right l₂ nainxs])
+-/
+
+lemma erase_sub (a : A) : ∀ l, erase a l ⊆ l
+:= sorry
+/-
+| []      := λ x xine, xine
+| (x::xs) := λ y xine,
+  by_cases
+    (λ aeqx : a = x, by rewrite [aeqx at xine, erase_cons_head at xine]; exact (or.inr xine))
+    (λ anex : a ≠ x,
+      have yinxe : y ∈ x :: erase a xs, by rewrite [erase_cons_tail _ anex at xine]; exact xine,
+      have subxs : erase a xs ⊆ xs, from erase_sub xs,
+      by_cases
+        (λ yeqx : y = x, by rewrite yeqx; apply mem_cons)
+        (λ ynex : y ≠ x,
+          have yine  : y ∈ erase a xs, from mem_of_ne_of_mem ynex yinxe,
+          have yinxs : y ∈ xs, from subxs yine,
+          or.inr yinxs))
+-/
+
+theorem mem_erase_of_ne_of_mem {a b : A} : ∀ {l : list A}, a ≠ b → a ∈ l → a ∈ erase b l
+:= sorry
+/-
+| []     n  i := absurd i !not_mem_nil
+| (c::l) n  i := by_cases
+  (λ beqc : b = c,
+   have ainl : a ∈ l, from or.elim (eq_or_mem_of_mem_cons i)
+     (λ aeqc : a = c, absurd aeqc (beqc ▸ n))
+     (λ ainl : a ∈ l, ainl),
+   by rewrite [beqc, erase_cons_head]; exact ainl)
+  (λ bnec : b ≠ c, by_cases
+    (λ aeqc : a = c,
+      have aux : a ∈ c :: erase b l, by rewrite [aeqc]; exact !mem_cons,
+      by rewrite [erase_cons_tail _ bnec]; exact aux)
+    (λ anec : a ≠ c,
+      have ainl  : a ∈ l, from mem_of_ne_of_mem anec i,
+      have ainel : a ∈ erase b l, from mem_erase_of_ne_of_mem n ainl,
+      have aux : a ∈ c :: erase b l, from mem_cons_of_mem _ ainel,
+      by rewrite [erase_cons_tail _ bnec]; exact aux)) --
+-/
+
+theorem mem_of_mem_erase {a b : A} : ∀ {l}, a ∈ erase b l → a ∈ l
+:= sorry
+/-
+| []     i := absurd i !not_mem_nil
+| (c::l) i := by_cases
+  (λ beqc : b = c, by rewrite [beqc at i, erase_cons_head at i]; exact (mem_cons_of_mem _ i))
+  (λ bnec : b ≠ c,
+    have i₁ : a ∈ c :: erase b l, by rewrite [erase_cons_tail _ bnec at i]; exact i,
+    or.elim (eq_or_mem_of_mem_cons i₁)
+      (λ aeqc  : a = c, by rewrite [aeqc]; exact !mem_cons)
+      (λ ainel : a ∈ erase b l,
+        have ainl : a ∈ l, from mem_of_mem_erase ainel,
+        mem_cons_of_mem _ ainl))
+-/
+
+theorem all_erase_of_all {p : A → Prop} (a : A) : ∀ {l}, all l p → all (erase a l) p
+:= sorry
+/-
+| []     h := by rewrite [erase_nil]; exact h
+| (b::l) h :=
+  have h₁ : all l p, from all_of_all_cons h,
+  have   h₂ : all (erase a l) p, from all_erase_of_all h₁,
+  have   pb : p b, from of_all_cons h,
+  have h₃ : all (b :: erase a l) p, from all_cons_of_all pb h₂,
+  by_cases
+    (λ aeqb : a = b, by rewrite [aeqb, erase_cons_head]; exact h₁)
+    (λ aneb : a ≠ b, by rewrite [erase_cons_tail _ aneb]; exact h₃)
+-/
+end erase
+
+/- disjoint -/
+section disjoint
+variable {A : Type}
+
+definition disjoint (l₁ l₂ : list A) : Prop := ∀ ⦃a⦄, (a ∈ l₁ → a ∈ l₂ → false)
+
+lemma disjoint_left {l₁ l₂ : list A} : disjoint l₁ l₂ → ∀ {a}, a ∈ l₁ → a ∉ l₂ :=
+λ d a, d a
+
+lemma disjoint_right {l₁ l₂ : list A} : disjoint l₁ l₂ → ∀ {a}, a ∈ l₂ → a ∉ l₁ :=
+λ d a i₂ i₁, d a i₁ i₂
+
+lemma disjoint.comm {l₁ l₂ : list A} : disjoint l₁ l₂ → disjoint l₂ l₁ :=
+λ d a i₂ i₁, d a i₁ i₂
+
+lemma disjoint_of_disjoint_cons_left {a : A} {l₁ l₂} : disjoint (a::l₁) l₂ → disjoint l₁ l₂ :=
+λ d x xinl₁, disjoint_left d (or.inr xinl₁)
+
+lemma disjoint_of_disjoint_cons_right {a : A} {l₁ l₂} : disjoint l₁ (a::l₂) → disjoint l₁ l₂ :=
+λ d, disjoint.comm (disjoint_of_disjoint_cons_left (disjoint.comm d))
+
+lemma disjoint_nil_left (l : list A) : disjoint [] l :=
+λ a ab, absurd ab (not_mem_nil a)
+
+lemma disjoint_nil_right (l : list A) : disjoint l [] :=
+disjoint.comm (disjoint_nil_left l)
+
+lemma disjoint_cons_of_not_mem_of_disjoint {a : A} {l₁ l₂} : a ∉ l₂ → disjoint l₁ l₂ → disjoint (a::l₁) l₂ :=
+λ nainl₂ d x (xinal₁ : x ∈ a::l₁),
+  or.elim (eq_or_mem_of_mem_cons xinal₁)
+    (λ xeqa  : x = a, eq.symm xeqa ▸ nainl₂)
+    (λ xinl₁ : x ∈ l₁, disjoint_left d xinl₁)
+
+lemma disjoint_of_disjoint_append_left_left : ∀ {l₁ l₂ l : list A}, disjoint (l₁++l₂) l → disjoint l₁ l
+| []      l₂ l d := disjoint_nil_left l
+| (x::xs) l₂ l d :=
+  have nxinl : x ∉ l, from disjoint_left d (mem_cons x _),
+  have d₁    : disjoint (xs++l₂) l, from disjoint_of_disjoint_cons_left d,
+  have d₂    : disjoint xs l, from disjoint_of_disjoint_append_left_left d₁,
+  disjoint_cons_of_not_mem_of_disjoint nxinl d₂
+
+lemma disjoint_of_disjoint_append_left_right : ∀ {l₁ l₂ l : list A}, disjoint (l₁++l₂) l → disjoint l₂ l
+| []      l₂ l d := d
+| (x::xs) l₂ l d :=
+  have d₁  : disjoint (xs++l₂) l, from disjoint_of_disjoint_cons_left d,
+  disjoint_of_disjoint_append_left_right d₁
+
+lemma disjoint_of_disjoint_append_right_left : ∀ {l₁ l₂ l : list A}, disjoint l (l₁++l₂) → disjoint l l₁ :=
+λ l₁ l₂ l d, disjoint.comm (disjoint_of_disjoint_append_left_left (disjoint.comm d))
+
+lemma disjoint_of_disjoint_append_right_right : ∀ {l₁ l₂ l : list A}, disjoint l (l₁++l₂) → disjoint l l₂ :=
+λ l₁ l₂ l d, disjoint.comm (disjoint_of_disjoint_append_left_right (disjoint.comm d))
+
+end disjoint
+
+/- no duplicates predicate -/
+
+inductive nodup {A : Type} : list A → Prop :=
+| ndnil  : nodup []
+| ndcons : ∀ {a l}, a ∉ l → nodup l → nodup (a::l)
+
+section nodup
+open nodup
+variables {A B : Type}
+
+theorem nodup_nil : @nodup A [] :=
+ndnil
+
+theorem nodup_cons {a : A} {l : list A} : a ∉ l → nodup l → nodup (a::l)  :=
+λ i n, ndcons i n
+
+theorem nodup_singleton (a : A) : nodup [a] :=
+nodup_cons (not_mem_nil a) nodup_nil
+
+theorem nodup_of_nodup_cons : ∀ {a : A} {l : list A}, nodup (a::l) → nodup l
+| a xs (ndcons i n) := n
+
+theorem not_mem_of_nodup_cons : ∀ {a : A} {l : list A}, nodup (a::l) → a ∉ l
+| a xs (ndcons i n) := i
+
+theorem not_nodup_cons_of_mem {a : A} {l : list A} : a ∈ l → ¬ nodup (a :: l) :=
+λ ainl d, absurd ainl (not_mem_of_nodup_cons d)
+
+theorem not_nodup_cons_of_not_nodup {a : A} {l : list A} : ¬ nodup l → ¬ nodup (a :: l) :=
+λ nd d, absurd (nodup_of_nodup_cons d) nd
+
+theorem nodup_of_nodup_append_left : ∀ {l₁ l₂ : list A}, nodup (l₁++l₂) → nodup l₁
+| []      l₂ n := nodup_nil
+| (x::xs) l₂ n :=
+  have ndxs     : nodup xs,   from nodup_of_nodup_append_left (nodup_of_nodup_cons n),
+  have nxinxsl₂ : x ∉ xs++l₂, from not_mem_of_nodup_cons n,
+  have nxinxs   : x ∉ xs,     from not_mem_of_not_mem_append_left nxinxsl₂,
+  nodup_cons nxinxs ndxs
+
+theorem nodup_of_nodup_append_right : ∀ {l₁ l₂ : list A}, nodup (l₁++l₂) → nodup l₂
+| []      l₂ n := n
+| (x::xs) l₂ n := nodup_of_nodup_append_right (nodup_of_nodup_cons n)
+
+theorem disjoint_of_nodup_append : ∀ {l₁ l₂ : list A}, nodup (l₁++l₂) → disjoint l₁ l₂
+| []      l₂  d := disjoint_nil_left l₂
+| (x::xs) l₂  d :=
+  have nodup (x::(xs++l₂)),    from d,
+  have x ∉ xs++l₂,             from not_mem_of_nodup_cons this,
+  have nxinl₂ : x ∉ l₂,        from not_mem_of_not_mem_append_right this,
+  take a, suppose a ∈ x::xs,
+    or.elim (eq_or_mem_of_mem_cons this)
+      (suppose a = x, eq.symm this ▸ nxinl₂)
+      (suppose ainxs : a ∈ xs,
+        have nodup (x::(xs++l₂)), from d,
+        have nodup (xs++l₂),      from nodup_of_nodup_cons this,
+        have disjoint xs l₂,      from disjoint_of_nodup_append this,
+        disjoint_left this ainxs)
+
+theorem nodup_append_of_nodup_of_nodup_of_disjoint : ∀ {l₁ l₂ : list A}, nodup l₁ → nodup l₂ → disjoint l₁ l₂ → nodup (l₁++l₂)
+| []      l₂ d₁ d₂ dsj := sorry -- by rewrite [append_nil_left]; exact d₂
+| (x::xs) l₂ d₁ d₂ dsj :=
+  have ndxs     : nodup xs,            from nodup_of_nodup_cons d₁,
+  have disjoint xs l₂,                 from disjoint_of_disjoint_cons_left dsj,
+  have ndxsl₂   : nodup (xs++l₂),      from nodup_append_of_nodup_of_nodup_of_disjoint ndxs d₂ this,
+  have nxinxs   : x ∉ xs,              from not_mem_of_nodup_cons d₁,
+  have x ∉ l₂,                         from disjoint_left dsj (mem_cons x xs),
+  have x ∉ xs++l₂,                     from not_mem_append nxinxs this,
+  nodup_cons this ndxsl₂
+
+theorem nodup_app_comm {l₁ l₂ : list A} (d : nodup (l₁++l₂)) : nodup (l₂++l₁) :=
+have d₁  : nodup l₁,       from nodup_of_nodup_append_left d,
+have d₂  : nodup l₂,       from nodup_of_nodup_append_right d,
+have dsj : disjoint l₁ l₂, from disjoint_of_nodup_append d,
+nodup_append_of_nodup_of_nodup_of_disjoint d₂ d₁ (disjoint.comm dsj)
+
+theorem nodup_head {a : A} {l₁ l₂ : list A} (d : nodup (l₁++(a::l₂))) : nodup (a::(l₁++l₂)) :=
+have d₁    : nodup (a::(l₂++l₁)), from nodup_app_comm d,
+have d₂    : nodup (l₂++l₁),      from nodup_of_nodup_cons d₁,
+have d₃    : nodup (l₁++l₂),      from nodup_app_comm d₂,
+have nain  : a ∉ l₂++l₁,          from not_mem_of_nodup_cons d₁,
+have nain₂ : a ∉ l₂,              from not_mem_of_not_mem_append_left nain,
+have nain₁ : a ∉ l₁,              from not_mem_of_not_mem_append_right nain,
+nodup_cons (not_mem_append nain₁ nain₂) d₃
+
+theorem nodup_middle {a : A} {l₁ l₂ : list A} (d : nodup (a::(l₁++l₂))) : nodup (l₁++(a::l₂)) :=
+have d₁    : nodup (l₁++l₂),      from nodup_of_nodup_cons d,
+have nain  : a ∉ l₁++l₂,          from not_mem_of_nodup_cons d,
+have disj  : disjoint l₁ l₂,      from disjoint_of_nodup_append d₁,
+have d₂    : nodup l₁,            from nodup_of_nodup_append_left d₁,
+have d₃    : nodup l₂,            from nodup_of_nodup_append_right d₁,
+have nain₂ : a ∉ l₂,              from not_mem_of_not_mem_append_right nain,
+have nain₁ : a ∉ l₁,              from not_mem_of_not_mem_append_left nain,
+have d₄    : nodup (a::l₂),       from nodup_cons nain₂ d₃,
+have disj₂ : disjoint l₁ (a::l₂), from disjoint.comm (disjoint_cons_of_not_mem_of_disjoint nain₁ (disjoint.comm disj)),
+nodup_append_of_nodup_of_nodup_of_disjoint d₂ d₄ disj₂
+
+theorem nodup_map {f : A → B} (inj : injective f) : ∀ {l : list A}, nodup l → nodup (map f l)
+:= sorry
+/-
+| []      n := begin rewrite [map_nil], apply nodup_nil end
+| (x::xs) n :=
+  have nxinxs : x ∉ xs,           from not_mem_of_nodup_cons n,
+  have ndxs   : nodup xs,         from nodup_of_nodup_cons n,
+  have ndmfxs : nodup (map f xs), from nodup_map ndxs,
+  have nfxinm : f x ∉ map f xs,   from
+    λ ab : f x ∈ map f xs,
+      obtain (y : A) (yinxs : y ∈ xs) (fyfx : f y = f x), from exists_of_mem_map ab,
+      have yeqx : y = x, from inj fyfx,
+      by subst y; contradiction,
+  nodup_cons nfxinm ndmfxs
+-/
+
+theorem nodup_erase_of_nodup [decidable_eq A] (a : A) : ∀ {l}, nodup l → nodup (erase a l)
+:= sorry
+/-
+| []     n := nodup_nil
+| (b::l) n := by_cases
+  (λ aeqb : a = b, by rewrite [aeqb, erase_cons_head]; exact (nodup_of_nodup_cons n))
+  (λ aneb : a ≠ b,
+    have nbinl   : b ∉ l,                  from not_mem_of_nodup_cons n,
+    have ndl     : nodup l,                from nodup_of_nodup_cons n,
+    have ndeal   : nodup (erase a l),      from nodup_erase_of_nodup ndl,
+    have nbineal : b ∉ erase a l,          from λ i, absurd (erase_sub _ _ i) nbinl,
+    have aux   : nodup (b :: erase a l), from nodup_cons nbineal ndeal,
+    by rewrite [erase_cons_tail _ aneb]; exact aux)
+-/
+
+theorem mem_erase_of_nodup [decidable_eq A] (a : A) : ∀ {l}, nodup l → a ∉ erase a l
+:= sorry
+/-
+| []     n := !not_mem_nil
+| (b::l) n :=
+  have ndl     : nodup l,       from nodup_of_nodup_cons n,
+  have naineal : a ∉ erase a l, from mem_erase_of_nodup ndl,
+  have nbinl : b ∉ l,         from not_mem_of_nodup_cons n,
+  by_cases
+  (λ aeqb : a = b, by rewrite [aeqb, erase_cons_head]; exact nbinl)
+  (λ aneb : a ≠ b,
+    have aux : a ∉ b :: erase a l, from
+      assume ainbeal : a ∈ b :: erase a l, or.elim (eq_or_mem_of_mem_cons ainbeal)
+        (λ aeqb   : a = b, absurd aeqb aneb)
+        (λ aineal : a ∈ erase a l, absurd aineal naineal),
+    by rewrite [erase_cons_tail _ aneb]; exact aux)
+-/
+
+definition erase_dup [decidable_eq A] : list A → list A
+| []        :=  []
+| (x :: xs) :=  if x ∈ xs then erase_dup xs else x :: erase_dup xs
+
+theorem erase_dup_nil [decidable_eq A] : erase_dup [] = ([] : list A) := rfl
+
+theorem erase_dup_cons_of_mem [decidable_eq A] {a : A} {l : list A} : a ∈ l → erase_dup (a::l) = erase_dup l :=
+assume ainl, calc
+  erase_dup (a::l) = if a ∈ l then erase_dup l else a :: erase_dup l : rfl
+              ...  = erase_dup l                                     : if_pos ainl
+
+theorem erase_dup_cons_of_not_mem [decidable_eq A] {a : A} {l : list A} : a ∉ l → erase_dup (a::l) = a :: erase_dup l :=
+assume nainl, calc
+  erase_dup (a::l) = if a ∈ l then erase_dup l else a :: erase_dup l : rfl
+              ...  = a :: erase_dup l                                : if_neg nainl
+
+theorem mem_erase_dup [decidable_eq A] {a : A} : ∀ {l}, a ∈ l → a ∈ erase_dup l
+:= sorry
+/-
+| []     h  := absurd h !not_mem_nil
+| (b::l) h  := by_cases
+  (λ binl  : b ∈ l, or.elim (eq_or_mem_of_mem_cons h)
+    (λ aeqb : a = b, by rewrite [erase_dup_cons_of_mem binl, -aeqb at binl]; exact (mem_erase_dup binl))
+    (λ ainl : a ∈ l, by rewrite [erase_dup_cons_of_mem binl]; exact (mem_erase_dup ainl)))
+  (λ nbinl : b ∉ l, or.elim (eq_or_mem_of_mem_cons h)
+    (λ aeqb : a = b, by rewrite [erase_dup_cons_of_not_mem nbinl, aeqb]; exact !mem_cons)
+    (λ ainl : a ∈ l, by rewrite [erase_dup_cons_of_not_mem nbinl]; exact (or.inr (mem_erase_dup ainl))))
+-/
+
+theorem mem_of_mem_erase_dup [decidable_eq A] {a : A} : ∀ {l}, a ∈ erase_dup l → a ∈ l
+:= sorry
+/-
+| []     h := by rewrite [erase_dup_nil at h]; exact h
+| (b::l) h := by_cases
+  (λ binl  : b ∈ l,
+    have h₁ : a ∈ erase_dup l, by rewrite [erase_dup_cons_of_mem binl at h]; exact h,
+    or.inr (mem_of_mem_erase_dup h₁))
+  (λ nbinl : b ∉ l,
+    have h₁ : a ∈ b :: erase_dup l, by rewrite [erase_dup_cons_of_not_mem nbinl at h]; exact h,
+    or.elim (eq_or_mem_of_mem_cons h₁)
+      (λ aeqb  : a = b, by rewrite aeqb; exact !mem_cons)
+      (λ ainel : a ∈ erase_dup l, or.inr (mem_of_mem_erase_dup ainel)))
+-/
+
+theorem erase_dup_sub [decidable_eq A] (l : list A) : erase_dup l ⊆ l :=
+λ a i, mem_of_mem_erase_dup i
+
+theorem sub_erase_dup [decidable_eq A] (l : list A) : l ⊆ erase_dup l :=
+λ a i, mem_erase_dup i
+
+theorem nodup_erase_dup [decidable_eq A] : ∀ l : list A, nodup (erase_dup l)
+:= sorry
+/-
+| []        := by rewrite erase_dup_nil; exact nodup_nil
+| (a::l)    := by_cases
+  (λ ainl  : a ∈ l, by rewrite [erase_dup_cons_of_mem ainl]; exact (nodup_erase_dup l))
+  (λ nainl : a ∉ l,
+    have r   : nodup (erase_dup l), from nodup_erase_dup l,
+    have nin : a ∉ erase_dup l, from
+      assume ab : a ∈ erase_dup l, absurd (mem_of_mem_erase_dup ab) nainl,
+    by rewrite [erase_dup_cons_of_not_mem nainl]; exact (nodup_cons nin r))
+-/
+
+theorem erase_dup_eq_of_nodup [decidable_eq A] : ∀ {l : list A}, nodup l → erase_dup l = l
+| []     d := rfl
+| (a::l) d :=
+  have nainl : a ∉ l, from not_mem_of_nodup_cons d,
+  have dl : nodup l,  from nodup_of_nodup_cons d,
+  sorry -- by rewrite [erase_dup_cons_of_not_mem nainl, erase_dup_eq_of_nodup dl]
+
+attribute [instance]
+definition decidable_nodup [decidable_eq A] : ∀ (l : list A), decidable (nodup l)
+| []     := tt nodup_nil
+| (a::l) :=
+  match (decidable_mem a l) with
+  | (tt p) := ff (not_nodup_cons_of_mem p)
+  | (ff n) :=
+    match (decidable_nodup l) with
+    | (tt nd) := tt (nodup_cons n nd)
+    | (ff d)  := ff (not_nodup_cons_of_not_nodup d)
+    end
+  end
+
+theorem nodup_product : ∀ {l₁ : list A} {l₂ : list B}, nodup l₁ → nodup l₂ → nodup (product l₁ l₂)
+| []      l₂ n₁ n₂ := nodup_nil
+| (a::l₁) l₂ n₁ n₂ :=
+  have nainl₁ : a ∉ l₁,                      from not_mem_of_nodup_cons n₁,
+  have n₃    : nodup l₁,                     from nodup_of_nodup_cons n₁,
+  have n₄    : nodup (product l₁ l₂),  from nodup_product n₃ n₂,
+  have dgen  : ∀ l, nodup l → nodup (map (λ b, (a, b)) l)
+    | []     h := nodup_nil
+    | (x::l) h :=
+      have dl   : nodup l,                      from nodup_of_nodup_cons h,
+      have dm   : nodup (map (λ b, (a, b)) l),  from dgen l dl,
+      have nxin : x ∉ l,                        from not_mem_of_nodup_cons h,
+      have npin : (a, x) ∉ map (λ b, (a, b)) l, from
+        assume pin, absurd (mem_of_mem_map_pair₁ pin) nxin,
+      nodup_cons npin dm,
+  have dm    : nodup (map (λ b, (a, b)) l₂), from dgen l₂ n₂,
+  have dsj   : disjoint (map (λ b, (a, b)) l₂) (product l₁ l₂), from
+    λ p, match p with
+         | (a₁, b₁) :=
+            λ (i₁ : (a₁, b₁) ∈ map (λ b, (a, b)) l₂) (i₂ : (a₁, b₁) ∈ product l₁ l₂),
+              have a₁inl₁ : a₁ ∈ l₁, from mem_of_mem_product_left i₂,
+              have a₁eqa : a₁ = a, from eq_of_mem_map_pair₁ i₁,
+              absurd (a₁eqa ▸ a₁inl₁) nainl₁
+         end,
+  nodup_append_of_nodup_of_nodup_of_disjoint dm n₄ dsj
+
+theorem nodup_filter (p : A → Prop) [decidable_pred p] : ∀ {l : list A}, nodup l → nodup (filter p l)
+:= sorry
+/-
+| []     nd := nodup_nil
+| (a::l) nd :=
+  have   nainl : a ∉ l,              from not_mem_of_nodup_cons nd,
+  have   ndl   : nodup l,            from nodup_of_nodup_cons nd,
+  have ndf   : nodup (filter p l), from nodup_filter ndl,
+  have nainf : a ∉ filter p l,     from
+    assume ainf, absurd (mem_of_mem_filter ainf) nainl,
+  by_cases
+    (λ pa  : p a, by rewrite [filter_cons_of_pos _ pa]; exact (nodup_cons nainf ndf))
+    (λ npa : ¬ p a, by rewrite [filter_cons_of_neg _ npa]; exact ndf)
+-/
+
+lemma dmap_nodup_of_dinj {p : A → Prop} [h : decidable_pred p] {f : Π a, p a → B} (Pdi : dinj p f):
+    ∀ {l : list A}, nodup l → nodup (dmap p f l)
+:= sorry
+/-
+| []     := take P, nodup.ndnil
+| (a::l) := take Pnodup,
+              decidable.rec_on (h a)
+                (λ Pa,
+                  begin
+                    rewrite [dmap_cons_of_pos Pa],
+                    apply nodup_cons,
+                    apply (not_mem_dmap_of_dinj_of_not_mem Pdi Pa),
+                    exact not_mem_of_nodup_cons Pnodup,
+                    exact dmap_nodup_of_dinj (nodup_of_nodup_cons Pnodup)
+                  end)
+                (λ nPa,
+                  begin
+                    rewrite [dmap_cons_of_neg nPa],
+                    exact dmap_nodup_of_dinj (nodup_of_nodup_cons Pnodup)
+                  end)
+-/
+end nodup
+
+/- upto -/
+definition upto : nat → list nat
+| 0     := []
+| (n+1) := n :: upto n
+
+theorem upto_nil  : upto 0 = nil := rfl
+
+theorem upto_succ (n : nat) : upto (succ n) = n :: upto n := rfl
+
+theorem length_upto : ∀ n, length (upto n) = n
+:= sorry
+/-
+| 0        := rfl
+| (succ n) := by rewrite [upto_succ, length_cons, length_upto]
+-/
+
+theorem upto_ne_nil_of_ne_zero {n : ℕ} (H : n ≠ 0) : upto n ≠ nil :=
+sorry
+/-
+suppose upto n = nil,
+have upto n = upto 0, from upto_nil ▸ this,
+have n = 0, from calc
+     n = length (upto n) : by rewrite length_upto
+   ... = length (upto 0) : by rewrite this
+   ... = 0               : by rewrite length_upto,
+H this
+-/
+
+theorem upto_less : ∀ n, all (upto n) (λ i, i < n)
+| 0        := trivial
+| (succ n) :=
+   have alln : all (upto n) (λ i, i < n), from upto_less n,
+   all_cons_of_all (lt.base n) (all_implies alln (λ x h, lt.step h))
+
+theorem nodup_upto : ∀ n, nodup (upto n)
+| 0     := nodup_nil
+| (n+1) :=
+  have d : nodup (upto n), from nodup_upto n,
+  have n : n ∉ upto n, from
+    assume i : n ∈ upto n, absurd (of_mem_of_all i (upto_less n)) (nat.lt_irrefl n),
+  nodup_cons n d
+
+theorem lt_of_mem_upto {n i : nat} : i ∈ upto n → i < n :=
+assume i, of_mem_of_all i (upto_less n)
+
+theorem mem_upto_succ_of_mem_upto {n i : nat} : i ∈ upto n → i ∈ upto (succ n) :=
+assume i, mem_cons_of_mem _ i
+
+theorem mem_upto_of_lt : ∀ {n i : nat}, i < n → i ∈ upto n
+| 0        i h := absurd h (not_lt_zero i)
+| (succ n) i h :=
+sorry
+/-
+begin
+  cases h with m h',
+  { rewrite upto_succ, apply mem_cons},
+  { exact mem_upto_succ_of_mem_upto (mem_upto_of_lt h')}
+end
+-/
+lemma upto_step : ∀ {n : nat}, upto (succ n) = (map succ (upto n))++[0]
+| 0        := rfl
+| (succ n) := sorry -- begin rewrite [upto_succ n, map_cons, append_cons, -upto_step] end
+
+/- union -/
+section union
+variable {A : Type}
+variable [H : decidable_eq A]
+include H
+
+definition union : list A → list A → list A
+| []      l₂ := l₂
+| (a::l₁) l₂ := if a ∈ l₂ then union l₁ l₂ else a :: union l₁ l₂
+
+theorem nil_union (l : list A) : union [] l = l := rfl
+
+theorem union_cons_of_mem {a : A} {l₂} : ∀ (l₁), a ∈ l₂ → union (a::l₁) l₂ = union l₁ l₂ :=
+take l₁, assume ainl₂, calc
+  union (a::l₁) l₂ = if a ∈ l₂ then union l₁ l₂ else a :: union l₁ l₂ : rfl
+                  ...   = union l₁ l₂                                           : if_pos ainl₂
+
+theorem union_cons_of_not_mem {a : A} {l₂} : ∀ (l₁), a ∉ l₂ → union (a::l₁) l₂ = a :: union l₁ l₂ :=
+take l₁, assume nainl₂, calc
+  union (a::l₁) l₂ = if a ∈ l₂ then union l₁ l₂ else a :: union l₁ l₂ : rfl
+                  ...   = a :: union l₁ l₂                                      : if_neg nainl₂
+
+theorem union_nil : ∀ (l : list A), union l [] = l
+| []     := nil_union nil
+| (a::l) := sorry -- by rewrite [union_cons_of_not_mem _ !not_mem_nil, union_nil]
+
+theorem mem_or_mem_of_mem_union : ∀ {l₁ l₂} {a : A}, a ∈ union l₁ l₂ → a ∈ l₁ ∨ a ∈ l₂
+:= sorry
+/-
+| []      l₂ a ainl₂ := by rewrite nil_union at ainl₂; exact (or.inr (ainl₂))
+| (b::l₁) l₂ a ainbl₁l₂ := by_cases
+  (λ binl₂  : b ∈ l₂,
+    have ainl₁l₂ : a ∈ union l₁ l₂, by rewrite [union_cons_of_mem l₁ binl₂ at ainbl₁l₂]; exact ainbl₁l₂,
+    or.elim (mem_or_mem_of_mem_union ainl₁l₂)
+      (λ ainl₁, or.inl (mem_cons_of_mem _ ainl₁))
+      (λ ainl₂, or.inr ainl₂))
+  (λ nbinl₂ : b ∉ l₂,
+    have ainb_l₁l₂ : a ∈ b :: union l₁ l₂, by rewrite [union_cons_of_not_mem l₁ nbinl₂ at ainbl₁l₂]; exact ainbl₁l₂,
+    or.elim (eq_or_mem_of_mem_cons ainb_l₁l₂)
+      (λ aeqb, by rewrite aeqb; exact (or.inl !mem_cons))
+      (λ ainl₁l₂,
+        or.elim (mem_or_mem_of_mem_union ainl₁l₂)
+          (λ ainl₁, or.inl (mem_cons_of_mem _ ainl₁))
+          (λ ainl₂, or.inr ainl₂)))
+-/
+
+theorem mem_union_right {a : A} : ∀ (l₁) {l₂}, a ∈ l₂ → a ∈ union l₁ l₂
+:= sorry
+/-
+| []      l₂  h := by rewrite nil_union; exact h
+| (b::l₁) l₂  h := by_cases
+  (λ binl₂ : b ∈ l₂, by rewrite [union_cons_of_mem _ binl₂]; exact (mem_union_right _ h))
+  (λ nbinl₂ : b ∉ l₂, by rewrite [union_cons_of_not_mem _ nbinl₂]; exact (mem_cons_of_mem _ (mem_union_right _ h)))
+-/
+
+theorem mem_union_left {a : A} : ∀ {l₁} (l₂), a ∈ l₁ → a ∈ union l₁ l₂
+:= sorry
+/-
+| []      l₂  h := absurd h !not_mem_nil
+| (b::l₁) l₂  h := by_cases
+  (λ binl₂  : b ∈ l₂, or.elim (eq_or_mem_of_mem_cons h)
+    (λ aeqb  : a = b,
+      by rewrite [union_cons_of_mem l₁ binl₂, -aeqb at binl₂]; exact (mem_union_right _ binl₂))
+    (λ ainl₁ : a ∈ l₁,
+      by rewrite [union_cons_of_mem l₁ binl₂]; exact (mem_union_left _ ainl₁)))
+  (λ nbinl₂ : b ∉ l₂, or.elim (eq_or_mem_of_mem_cons h)
+    (λ aeqb  : a = b,
+      by rewrite [union_cons_of_not_mem l₁ nbinl₂, aeqb]; exact !mem_cons)
+    (λ ainl₁ : a ∈ l₁,
+      by rewrite [union_cons_of_not_mem l₁ nbinl₂]; exact (mem_cons_of_mem _ (mem_union_left _ ainl₁))))
+-/
+
+theorem mem_union_cons (a : A) (l₁ : list A) (l₂ : list A) : a ∈ union (a::l₁) l₂ :=
+sorry
+/-
+by_cases
+  (λ ainl₂  : a ∈ l₂, mem_union_right _ ainl₂)
+  (λ nainl₂ : a ∉ l₂, by rewrite [union_cons_of_not_mem _ nainl₂]; exact !mem_cons)
+-/
+
+theorem nodup_union_of_nodup_of_nodup : ∀ {l₁ l₂ : list A}, nodup l₁ → nodup l₂ → nodup (union l₁ l₂)
+:= sorry
+/-
+| []      l₂ n₁   nl₂ := by rewrite nil_union; exact nl₂
+| (a::l₁) l₂ nal₁ nl₂ :=
+  have nl₁   : nodup l₁, from nodup_of_nodup_cons nal₁,
+  have nl₁l₂ : nodup (union l₁ l₂), from nodup_union_of_nodup_of_nodup nl₁ nl₂,
+  by_cases
+    (λ ainl₂  : a ∈ l₂,
+       by rewrite [union_cons_of_mem l₁ ainl₂]; exact nl₁l₂)
+    (λ nainl₂ : a ∉ l₂,
+       have nainl₁ : a ∉ l₁, from not_mem_of_nodup_cons nal₁,
+       have nainl₁l₂ : a ∉ union l₁ l₂, from
+         assume ainl₁l₂ : a ∈ union l₁ l₂, or.elim (mem_or_mem_of_mem_union ainl₁l₂)
+           (λ ainl₁, absurd ainl₁ nainl₁)
+           (λ ainl₂, absurd ainl₂ nainl₂),
+       by rewrite [union_cons_of_not_mem l₁ nainl₂]; exact (nodup_cons nainl₁l₂ nl₁l₂))
+-/
+
+theorem union_eq_append : ∀ {l₁ l₂ : list A}, disjoint l₁ l₂ → union l₁ l₂ = append l₁ l₂
+:= sorry
+/-
+| []      l₂ d := rfl
+| (a::l₁) l₂ d :=
+  have nainl₂ : a ∉ l₂, from disjoint_left d !mem_cons,
+  have d₁ : disjoint l₁ l₂, from disjoint_of_disjoint_cons_left d,
+  by rewrite [union_cons_of_not_mem _ nainl₂, append_cons, union_eq_append d₁]
+-/
+
+theorem all_union {p : A → Prop} : ∀ {l₁ l₂ : list A}, all l₁ p → all l₂ p → all (union l₁ l₂) p
+:= sorry
+/-
+| []      l₂ h₁ h₂ := h₂
+| (a::l₁) l₂ h₁ h₂ :=
+  have h₁'   : all l₁ p, from all_of_all_cons h₁,
+  have pa    : p a, from of_all_cons h₁,
+  have au  : all (union l₁ l₂) p, from all_union h₁' h₂,
+  have au' : all (a :: union l₁ l₂) p, from all_cons_of_all pa au,
+  by_cases
+    (λ ainl₂  : a ∈ l₂, by rewrite [union_cons_of_mem _ ainl₂]; exact au)
+    (λ nainl₂ : a ∉ l₂, by rewrite [union_cons_of_not_mem _ nainl₂]; exact au')
+-/
+
+theorem all_of_all_union_left {p : A → Prop} : ∀ {l₁ l₂ : list A}, all (union l₁ l₂) p → all l₁ p
+:= sorry
+/-
+| []      l₂  h := trivial
+| (a::l₁) l₂  h :=
+  have ain : a ∈ union (a::l₁) l₂, from !mem_union_cons,
+  have pa  : p a, from of_mem_of_all ain h,
+  by_cases
+  (λ ainl₂  : a ∈ l₂,
+    have al₁l₂ : all (union l₁ l₂) p, by rewrite [union_cons_of_mem _ ainl₂ at h]; exact h,
+    have al₁   : all l₁ p, from all_of_all_union_left al₁l₂,
+    all_cons_of_all pa al₁)
+  (λ nainl₂ : a ∉ l₂,
+    have aal₁l₂ : all (a::union l₁ l₂) p, by rewrite [union_cons_of_not_mem _ nainl₂ at h]; exact h,
+    have al₁l₂ : all (union l₁ l₂) p, from all_of_all_cons aal₁l₂,
+    have al₁   : all l₁ p, from all_of_all_union_left al₁l₂,
+    all_cons_of_all pa al₁)
+-/
+
+theorem all_of_all_union_right {p : A → Prop} : ∀ {l₁ l₂ : list A}, all (union l₁ l₂) p → all l₂ p
+:= sorry
+/-
+| []      l₂ h := by rewrite [nil_union at h]; exact h
+| (a::l₁) l₂ h := by_cases
+  (λ ainl₂  : a ∈ l₂, by rewrite [union_cons_of_mem _ ainl₂ at h]; exact (all_of_all_union_right h))
+  (λ nainl₂ : a ∉ l₂,
+    have h₁ : all (a :: union l₁ l₂) p, by rewrite [union_cons_of_not_mem _ nainl₂ at h]; exact h,
+    all_of_all_union_right (all_of_all_cons h₁))
+-/
+
+variable {B : Type}
+theorem foldl_union_of_disjoint (f : B → A → B) (b : B) {l₁ l₂ : list A} (d : disjoint l₁ l₂)
+        : foldl f b (union l₁ l₂) = foldl f (foldl f b l₁) l₂ :=
+sorry -- by rewrite [union_eq_append d, foldl_append]
+
+theorem foldr_union_of_dijoint  (f : A → B → B) (b : B) {l₁ l₂ : list A} (d : disjoint l₁ l₂)
+        : foldr f b (union l₁ l₂) = foldr f (foldr f b l₂) l₁ :=
+sorry -- by rewrite [union_eq_append d, foldr_append]
+end union
+
+/- insert -/
+section insert
+variable {A : Type}
+variable [H : decidable_eq A]
+include H
+
+definition insert (a : A) (l : list A) : list A :=
+if a ∈ l then l else a::l
+
+theorem insert_eq_of_mem {a : A} {l : list A} : a ∈ l → insert a l = l :=
+assume ainl, if_pos ainl
+
+theorem insert_eq_of_not_mem {a : A} {l : list A} : a ∉ l → insert a l = a::l :=
+assume nainl, if_neg nainl
+
+theorem mem_insert (a : A) (l : list A) : a ∈ insert a l :=
+sorry
+/-
+by_cases
+  (λ ainl  : a ∈ l, by rewrite [insert_eq_of_mem ainl]; exact ainl)
+  (λ nainl : a ∉ l, by rewrite [insert_eq_of_not_mem nainl]; exact !mem_cons)
+-/
+
+theorem mem_insert_of_mem {a : A} (b : A) {l : list A} : a ∈ l → a ∈ insert b l :=
+sorry
+/-
+assume ainl, by_cases
+  (λ binl  : b ∈ l, by rewrite [insert_eq_of_mem binl]; exact ainl)
+  (λ nbinl : b ∉ l, by rewrite [insert_eq_of_not_mem nbinl]; exact (mem_cons_of_mem _ ainl))
+-/
+
+theorem eq_or_mem_of_mem_insert {x a : A} {l : list A} (H : x ∈ insert a l) : x = a ∨ x ∈ l :=
+decidable.by_cases
+  (assume H3: a ∈ l, or.inr (insert_eq_of_mem H3 ▸ H))
+  (assume H3: a ∉ l,
+    have H4: x ∈ a :: l, from insert_eq_of_not_mem H3 ▸ H,
+    iff.mp (mem_cons_iff x a l) H4)
+
+theorem mem_insert_iff (x a : A) (l : list A) : x ∈ insert a l ↔ x = a ∨ x ∈ l :=
+iff.intro
+  eq_or_mem_of_mem_insert
+  (assume H, or.elim H
+    (assume H' : x = a, eq.symm H' ▸ mem_insert a l)
+    (assume H' : x ∈ l, mem_insert_of_mem a H'))
+
+theorem nodup_insert (a : A) {l : list A} : nodup l → nodup (insert a l) :=
+sorry
+/-
+assume n, by_cases
+  (λ ainl  : a ∈ l, by rewrite [insert_eq_of_mem ainl]; exact n)
+  (λ nainl : a ∉ l, by rewrite [insert_eq_of_not_mem nainl]; exact (nodup_cons nainl n))
+-/
+
+theorem length_insert_of_mem {a : A} {l : list A} : a ∈ l → length (insert a l) = length l :=
+sorry -- assume ainl, by rewrite [insert_eq_of_mem ainl]
+
+theorem length_insert_of_not_mem {a : A} {l : list A} : a ∉ l → length (insert a l) = length l + 1 :=
+sorry -- assume nainl, by rewrite [insert_eq_of_not_mem nainl]
+
+theorem all_insert_of_all {p : A → Prop} {a : A} {l} : p a → all l p → all (insert a l) p :=
+sorry
+/-
+assume h₁ h₂, by_cases
+  (λ ainl  : a ∈ l, by rewrite [insert_eq_of_mem ainl]; exact h₂)
+  (λ nainl : a ∉ l, by rewrite [insert_eq_of_not_mem nainl]; exact (all_cons_of_all h₁ h₂))
+-/
+end insert
+
+/- inter -/
+section inter
+variable {A : Type}
+variable [H : decidable_eq A]
+include H
+
+definition inter : list A → list A → list A
+| []      l₂ := []
+| (a::l₁) l₂ := if a ∈ l₂ then a :: inter l₁ l₂ else inter l₁ l₂
+
+theorem inter_nil (l : list A) : inter [] l = [] := rfl
+
+theorem inter_cons_of_mem {a : A} (l₁ : list A) {l₂} : a ∈ l₂ → inter (a::l₁) l₂ = a :: inter l₁ l₂ :=
+assume i, if_pos i
+
+theorem inter_cons_of_not_mem {a : A} (l₁ : list A) {l₂} : a ∉ l₂ → inter (a::l₁) l₂ = inter l₁ l₂ :=
+assume i, if_neg i
+
+theorem mem_of_mem_inter_left : ∀ {l₁ l₂} {a : A}, a ∈ inter l₁ l₂ → a ∈ l₁
+:= sorry
+/-
+| []      l₂ a i := absurd i !not_mem_nil
+| (b::l₁) l₂ a i := by_cases
+  (λ binl₂  : b ∈ l₂,
+    have aux : a ∈ b :: inter l₁ l₂, by rewrite [inter_cons_of_mem _ binl₂ at i]; exact i,
+    or.elim (eq_or_mem_of_mem_cons aux)
+      (λ aeqb : a = b, by rewrite [aeqb]; exact !mem_cons)
+      (λ aini, mem_cons_of_mem _ (mem_of_mem_inter_left aini)))
+  (λ nbinl₂ : b ∉ l₂,
+    have ainl₁ : a ∈ l₁, by rewrite [inter_cons_of_not_mem _ nbinl₂ at i]; exact (mem_of_mem_inter_left i),
+    mem_cons_of_mem _ ainl₁)
+-/
+
+theorem mem_of_mem_inter_right : ∀ {l₁ l₂} {a : A}, a ∈ inter l₁ l₂ → a ∈ l₂
+:= sorry
+/-
+| []      l₂ a i := absurd i !not_mem_nil
+| (b::l₁) l₂ a i := by_cases
+  (λ binl₂  : b ∈ l₂,
+    have aux : a ∈ b :: inter l₁ l₂, by rewrite [inter_cons_of_mem _ binl₂ at i]; exact i,
+    or.elim (eq_or_mem_of_mem_cons aux)
+      (λ aeqb : a = b, by rewrite [aeqb]; exact binl₂)
+      (λ aini : a ∈ inter l₁ l₂, mem_of_mem_inter_right aini))
+  (λ nbinl₂ : b ∉ l₂,
+    by rewrite [inter_cons_of_not_mem _ nbinl₂ at i]; exact (mem_of_mem_inter_right i))
+-/
+
+theorem mem_inter_of_mem_of_mem : ∀ {l₁ l₂} {a : A}, a ∈ l₁ → a ∈ l₂ → a ∈ inter l₁ l₂
+:= sorry
+/-
+| []      l₂ a i₁ i₂ := absurd i₁ !not_mem_nil
+| (b::l₁) l₂ a i₁ i₂ := by_cases
+  (λ binl₂  : b ∈ l₂,
+    or.elim (eq_or_mem_of_mem_cons i₁)
+      (λ aeqb  : a = b,
+        by rewrite [inter_cons_of_mem _ binl₂, aeqb]; exact !mem_cons)
+     (λ ainl₁ : a ∈ l₁,
+        by rewrite [inter_cons_of_mem _ binl₂];
+           apply mem_cons_of_mem;
+           exact (mem_inter_of_mem_of_mem ainl₁ i₂)))
+  (λ nbinl₂ : b ∉ l₂,
+    or.elim (eq_or_mem_of_mem_cons i₁)
+     (λ aeqb  : a = b, absurd (aeqb ▸ i₂) nbinl₂)
+     (λ ainl₁ : a ∈ l₁,
+       by rewrite [inter_cons_of_not_mem _ nbinl₂]; exact (mem_inter_of_mem_of_mem ainl₁ i₂)))
+-/
+
+theorem nodup_inter_of_nodup : ∀ {l₁ : list A} (l₂), nodup l₁ → nodup (inter l₁ l₂)
+:= sorry
+/-
+| []      l₂ d := nodup_nil
+| (a::l₁) l₂ d :=
+  have d₁     : nodup l₁,            from nodup_of_nodup_cons d,
+  have d₂     : nodup (inter l₁ l₂), from nodup_inter_of_nodup _ d₁,
+  have nainl₁ : a ∉ l₁,              from not_mem_of_nodup_cons d,
+  have naini  : a ∉ inter l₁ l₂,     from λ i, absurd (mem_of_mem_inter_left i) nainl₁,
+  by_cases
+    (λ ainl₂  : a ∈ l₂, by rewrite [inter_cons_of_mem _ ainl₂]; exact (nodup_cons naini d₂))
+    (λ nainl₂ : a ∉ l₂, by rewrite [inter_cons_of_not_mem _ nainl₂]; exact d₂)
+-/
+
+theorem inter_eq_nil_of_disjoint : ∀ {l₁ l₂ : list A}, disjoint l₁ l₂ → inter l₁ l₂ = []
+:= sorry
+/-
+| []      l₂ d := rfl
+| (a::l₁) l₂ d :=
+  have aux_eq : inter l₁ l₂ = [], from inter_eq_nil_of_disjoint (disjoint_of_disjoint_cons_left d),
+  have nainl₂ : a ∉ l₂,           from disjoint_left d !mem_cons,
+  by rewrite [inter_cons_of_not_mem _ nainl₂, aux_eq]
+-/
+
+theorem all_inter_of_all_left {p : A → Prop} : ∀ {l₁} (l₂), all l₁ p → all (inter l₁ l₂) p
+:= sorry
+/-
+| []      l₂ h := trivial
+| (a::l₁) l₂ h :=
+  have h₁ : all l₁ p,                 from all_of_all_cons h,
+  have h₂ : all (inter l₁ l₂) p,      from all_inter_of_all_left _ h₁,
+  have pa : p a,                      from of_all_cons h,
+  have h₃ : all (a :: inter l₁ l₂) p, from all_cons_of_all pa h₂,
+  by_cases
+    (λ ainl₂  : a ∈ l₂, by rewrite [inter_cons_of_mem _ ainl₂]; exact h₃)
+    (λ nainl₂ : a ∉ l₂, by rewrite [inter_cons_of_not_mem _ nainl₂]; exact h₂)
+-/
+
+theorem all_inter_of_all_right {p : A → Prop} : ∀ (l₁) {l₂}, all l₂ p → all (inter l₁ l₂) p
+:= sorry
+/-
+| []      l₂ h := trivial
+| (a::l₁) l₂ h :=
+  have h₁ : all (inter l₁ l₂) p, from all_inter_of_all_right _ h,
+  by_cases
+    (λ ainl₂  : a ∈ l₂,
+      have pa : p a,                      from of_mem_of_all ainl₂ h,
+      have h₂ : all (a :: inter l₁ l₂) p, from all_cons_of_all pa h₁,
+      by rewrite [inter_cons_of_mem _ ainl₂]; exact h₂)
+    (λ nainl₂ : a ∉ l₂, by rewrite [inter_cons_of_not_mem _ nainl₂]; exact h₁)
+-/
+
+end inter
+end list

old_library/data/list/sort.lean

@@ -0,0 +1,227 @@
+/-
+Copyright (c) 2015 Leonardo de Moura. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+
+Naive sort for lists
+-/
+import data.list.comb data.list.set data.list.perm data.list.sorted logic.connectives algebra.order
+
+namespace list
+open decidable nat
+
+variables  {B A : Type}
+variable  (R : A → A → Prop)
+variable  [decR : decidable_rel R]
+include decR
+
+definition min_core : list A → A → A
+| []     a := a
+| (b::l) a := if R b a then min_core l b else min_core l a
+
+definition min : Π (l : list A), l ≠ nil → A
+| []     h := absurd rfl h
+| (a::l) h := min_core R l a
+
+variable  [decA : decidable_eq A]
+include decA
+
+variable {R}
+variables (to : total R) (tr : transitive R) (rf : reflexive R)
+
+section
+include to tr rf
+lemma min_core_lemma : ∀ {b l} a, b ∈ l ∨ b = a → R (min_core R l a) b
+:= sorry
+end
+
+/-
+| b []     a h := or.elim h
+  (suppose b ∈ [], absurd this !not_mem_nil)
+  (suppose b = a,
+    have R a a, from rf a,
+    begin subst b, unfold min_core, assumption end)
+| b (c::l) a h := or.elim h
+  (suppose b ∈ c :: l, or.elim (eq_or_mem_of_mem_cons this)
+    (suppose b = c,
+      or.elim (em (R c a))
+        (suppose R c a,
+          have R (min_core R l b) b, from min_core_lemma _ (or.inr rfl),
+          begin unfold min_core, rewrite [if_pos `R c a`], subst c, eassumption end)
+        (suppose ¬ R c a,
+          have R a c, from or_resolve_right (to c a) this,
+          have R (min_core R l a) a, from min_core_lemma _ (or.inr rfl),
+          have R (min_core R l a) c, from tr this `R a c`,
+          begin unfold min_core, rewrite [if_neg `¬ R c a`], subst b, exact `R (min_core R l a) c` end))
+    (suppose b ∈ l,
+      or.elim (em (R c a))
+        (suppose R c a,
+          have R (min_core R l c) b, from min_core_lemma _ (or.inl `b ∈ l`),
+          begin unfold min_core, rewrite [if_pos `R c a`], eassumption end)
+        (suppose ¬ R c a,
+          have R (min_core R l a) b, from min_core_lemma _ (or.inl `b ∈ l`),
+          begin unfold min_core, rewrite [if_neg `¬ R c a`], eassumption end)))
+  (suppose b = a,
+    have R (min_core R l a) b, from min_core_lemma _ (or.inr this),
+    or.elim (em (R c a))
+       (suppose R c a,
+         have R (min_core R l c) c, from min_core_lemma _ (or.inr rfl),
+         have R (min_core R l c) a, from tr this `R c a`,
+         begin unfold min_core, rewrite [if_pos `R c a`], subst b, exact `R (min_core R l c) a` end)
+       (suppose ¬ R c a, begin unfold min_core, rewrite [if_neg `¬ R c a`], eassumption end))
+-/
+
+lemma min_core_le_of_mem {b : A} {l : list A} (a : A) : b ∈ l → R (min_core R l a) b :=
+assume h : b ∈ l, min_core_lemma to tr rf a (or.inl h)
+
+lemma min_core_le {l : list A} (a : A) : R (min_core R l a) a :=
+min_core_lemma to tr rf a (or.inr rfl)
+
+lemma min_lemma : ∀ {l} (h : l ≠ nil), all l (R (min R l h))
+| []     h := absurd rfl h
+| (b::l) h :=
+  all_of_forall (take x, suppose x ∈ b::l,
+   or.elim (eq_or_mem_of_mem_cons this)
+     (suppose x = b,
+       have R (min_core R l b) b, from min_core_le to tr rf b,
+       sorry) -- begin subst x, unfold min, assumption end)
+     (suppose x ∈ l,
+       have R (min_core R l b) x, from min_core_le_of_mem to tr rf _ this,
+       sorry)) -- begin unfold min, assumption end))
+
+variable (R)
+
+lemma min_core_mem : ∀ l a, min_core R l a ∈ l ∨ min_core R l a = a
+| []     a := or.inr rfl
+| (b::l) a :=
+  sorry
+  /-
+  or.elim (em (R b a))
+  (suppose R b a,
+    begin
+      change (if R b a then min_core R l b else min_core R l a) ∈ b :: l ∨ (if R b a then min_core R l b else min_core R l a) = a,
+      rewrite [if_pos `R b a`],
+      apply  or.elim (min_core_mem l b),
+      suppose min_core R l b ∈ l, or.inl (mem_cons_of_mem _ this),
+      suppose min_core R l b = b, by rewrite this; exact or.inl !mem_cons
+    end)
+  (suppose ¬ R b a,
+    begin
+      unfold min_core, rewrite [if_neg `¬ R b a`],
+      apply  or.elim (min_core_mem l a),
+      suppose min_core R l a ∈ l, or.inl (mem_cons_of_mem _ this),
+      suppose min_core R l a = a, or.inr this
+    end)
+  -/
+
+lemma min_mem : ∀ (l : list A) (h : l ≠ nil), min R l h ∈ l
+| []     h := absurd rfl h
+| (a::l) h :=
+  sorry
+  /-
+  begin
+    unfold min,
+    apply or.elim (min_core_mem R l a),
+    suppose min_core R l a ∈ l, mem_cons_of_mem _ this,
+    suppose min_core R l a = a, by rewrite this; apply mem_cons
+  end
+  -/
+
+section
+include to tr rf
+lemma min_map (f : B → A) {l : list B} (h : l ≠ nil) :
+      all l (λ b, (R (min R (map f l) (map_ne_nil_of_ne_nil _ h))) (f b)):=
+sorry
+end
+  /-
+  begin
+    apply all_of_forall,
+    intro b Hb,
+    have Hfa : all (map f l) (R (min R (map f l) (map_ne_nil_of_ne_nil _ h))), from min_lemma to tr rf _,
+    have Hfb : f b ∈ map f l, from mem_map _ Hb,
+    exact of_mem_of_all Hfb Hfa
+  end
+  -/
+lemma min_map_all (f : B → A) {l : list B} (h : l ≠ nil) {b : B} (Hb : b ∈ l) :
+      R (min R (map f l) ((map_ne_nil_of_ne_nil _ h))) (f b) :=
+  of_mem_of_all Hb (min_map _ to tr rf f h)
+
+omit decR
+private lemma ne_nil {l : list A} {n : nat} : length l = succ n → l ≠ nil :=
+sorry -- assume h₁ h₂, by rewrite h₂ at h₁; contradiction
+
+include decR
+lemma sort_aux_lemma {l n} (h : length l = succ n) : length (erase (min R l (ne_nil h)) l) = n :=
+have min R l _ ∈ l, from min_mem R l (ne_nil h),
+have length (erase (min R l  _) l) = pred (length l), from length_erase_of_mem this,
+sorry -- by rewrite h at this; exact this
+
+definition sort_aux : Π (n : nat) (l : list A), length l = n → list A
+| 0        l h := []
+| (succ n) l h :=
+  let m  := min R l (ne_nil h) in
+  let l₁ := erase m l in
+  m :: sort_aux n l₁ (sort_aux_lemma R h)
+
+definition sort (l : list A) : list A :=
+sort_aux R (length l) l rfl
+
+open perm
+
+lemma sort_aux_perm : ∀ {n : nat} {l : list A} (h : length l = n), sort_aux R n l h ~ l
+| 0        l h :=
+  sorry
+  /-
+  begin
+   change [] ~ l,
+   rewrite [eq_nil_of_length_eq_zero h]
+  end
+  -/
+| (succ n) l h :=
+  let m := min R l (ne_nil h) in
+  have leq : length (erase m l) = n, from sort_aux_lemma R h,
+  calc m :: sort_aux R n (erase m l) leq
+         ~ m :: erase m l                   : perm.skip m (sort_aux_perm leq)
+     ... ~ l                                : perm.symm (perm_erase (min_mem _ _ _))
+
+lemma sort_perm (l : list A) : sort R l ~ l :=
+sort_aux_perm R rfl
+
+lemma strongly_sorted_sort_aux : ∀ {n : nat} {l : list A} (h : length l = n), strongly_sorted R (sort_aux R n l h)
+| 0        l h := strongly_sorted.base R
+| (succ n) l h :=
+  let m := min R l (ne_nil h) in
+  have leq    : length (erase m l) = n,                       from sort_aux_lemma R h,
+  have ss : strongly_sorted R (sort_aux R n (erase m l) leq), from strongly_sorted_sort_aux leq,
+  have all l (R m),                                           from min_lemma to tr rf (ne_nil h),
+  have hall : all (sort_aux R n (erase m l) leq) (R m),       from
+    all_of_forall (take x,
+      suppose x ∈ sort_aux R n (erase m l) leq,
+      have x ∈ erase m l, from mem_perm (sort_aux_perm R leq) this,
+      have x ∈ l,         from mem_of_mem_erase this,
+      show R m x,         from of_mem_of_all this sorry), -- `all l (R m)`),
+  strongly_sorted.step hall ss
+
+variable {R}
+
+lemma strongly_sorted_sort_core (to : total R) (tr : transitive R) (rf : reflexive R) (l : list A) : strongly_sorted R (sort R l) :=
+@strongly_sorted_sort_aux _ _ _ _ to tr rf (length l) l rfl
+
+lemma sort_eq_of_perm_core {l₁ l₂ : list A} (to : total R) (tr : transitive R) (rf : reflexive R) (asy : anti_symmetric R) (h : l₁ ~ l₂) : sort R l₁ = sort R l₂ :=
+have s₁ : sorted R (sort R l₁),  from sorted_of_strongly_sorted (strongly_sorted_sort_core to tr rf l₁),
+have s₂ : sorted R (sort R l₂),  from sorted_of_strongly_sorted (strongly_sorted_sort_core to tr rf l₂),
+have p  : sort R l₁ ~ sort R l₂, from calc
+  sort R l₁ ~ l₁        : sort_perm R l₁
+    ...     ~ l₂        : h
+    ...     ~ sort R l₂ : perm.symm $ sort_perm R l₂,
+eq_of_sorted_of_perm tr asy p s₁ s₂
+
+section
+omit decR
+lemma strongly_sorted_sort [decidable_linear_order A] (l : list A) : strongly_sorted le (sort le l) :=
+strongly_sorted_sort_core le.total (@le.trans A _) le.refl l
+
+lemma sort_eq_of_perm {l₁ l₂ : list A} [decidable_linear_order A] (h : l₁ ~ l₂) : sort le l₁ = sort le l₂ :=
+sort_eq_of_perm_core le.total (@le.trans A _) le.refl (@le.antisymm A _) h
+end
+end list

old_library/data/list/sorted.lean

@@ -0,0 +1,138 @@
+/-
+Copyright (c) 2015 Leonardo de Moura. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+import data.list.comb data.list.perm
+
+namespace list
+variable {A : Type}
+variable (R : A → A → Prop)
+
+inductive locally_sorted : list A → Prop :=
+| base0 : locally_sorted []
+| base  : ∀ a, locally_sorted [a]
+| step  : ∀ {a b l}, R a b → locally_sorted (b::l) → locally_sorted (a::b::l)
+
+inductive hd_rel (a : A) : list A → Prop :=
+| base : hd_rel a []
+| step : ∀ {b} (l), R a b → hd_rel a (b::l)
+
+inductive sorted : list A → Prop :=
+| base : sorted []
+| step : ∀ {a : A} {l : list A}, hd_rel R a l → sorted l → sorted (a::l)
+
+variable {R}
+
+lemma hd_rel_inv : ∀ {a b l}, hd_rel R a (b::l) → R a b :=
+sorry -- begin intros a b l h, cases h, assumption end
+
+lemma sorted_inv : ∀ {a l}, sorted R (a::l) → hd_rel R a l ∧ sorted R l :=
+sorry -- begin intros a l h, cases h, split, repeat assumption end
+
+lemma sorted.rect_on {P : list A → Type} : ∀ {l}, sorted R l → P [] → (∀ a l, sorted R l → P l → hd_rel R a l → P (a::l)) → P l
+| []     s h₁ h₂ := h₁
+| (a::l) s h₁ h₂ :=
+  have aux₁ : hd_rel R a l, from and.left (sorted_inv s),
+  have aux₂ : sorted R l,   from and.right (sorted_inv s),
+  have aux₃ : P l,          from sorted.rect_on aux₂ h₁ h₂,
+  h₂ a l aux₂ aux₃ aux₁
+
+lemma sorted_singleton (a : A) : sorted R [a] :=
+sorted.step (hd_rel.base R a) (sorted.base R)
+
+lemma sorted_of_locally_sorted : ∀ {l}, locally_sorted R l → sorted R l
+| []        h := sorted.base R
+| [a]       h := sorted_singleton a
+| (a::b::l) (locally_sorted.step h₁ h₂) :=
+  have sorted R (b::l), from sorted_of_locally_sorted h₂,
+  sorted.step (hd_rel.step _ h₁) this
+
+lemma locally_sorted_of_sorted : ∀ {l}, sorted R l → locally_sorted R l
+| []        h := locally_sorted.base0 R
+| [a]       h := locally_sorted.base R a
+| (a::b::l) (sorted.step (hd_rel.step _ h₁) h₂) :=
+  have locally_sorted R (b::l), from locally_sorted_of_sorted h₂,
+  locally_sorted.step h₁ this
+
+lemma locally_sorted_eq_sorted : @locally_sorted = @sorted :=
+funext (λ A, funext (λ R, funext (λ l, propext (iff.intro sorted_of_locally_sorted locally_sorted_of_sorted))))
+
+variable (R)
+
+inductive strongly_sorted : list A → Prop :=
+| base : strongly_sorted []
+| step : ∀ {a : A} {l : list A}, all l (R a) → strongly_sorted l → strongly_sorted (a::l)
+
+variable {R}
+
+lemma sorted_of_strongly_sorted : ∀ {l}, strongly_sorted R l → sorted R l
+| []        h := sorted.base R
+| [a]       h := sorted_singleton a
+| (a::b::l) (strongly_sorted.step h₁ h₂) :=
+  have aux : hd_rel R a (b::l), from hd_rel.step _ (of_all_cons h₁),
+  have sorted R (b::l),   from sorted_of_strongly_sorted h₂,
+  sorted.step aux this
+
+lemma sorted_extends (trans : transitive R) : ∀ {a l}, sorted R (a::l) → all l (R a)
+:= sorry
+/-
+| a []     h := !all_nil
+| a (b::l) h :=
+  have hd_rel R a (b::l), from and.left (sorted_inv h),
+  have R a b,             from hd_rel_inv this,
+  have all l (R b),       from sorted_extends (and.right (sorted_inv h)),
+  all_of_forall (take x, suppose x ∈ b::l,
+    or.elim (eq_or_mem_of_mem_cons this)
+      (suppose x = b, by subst x; assumption)
+      (suppose x ∈ l,
+        have R b x, from of_mem_of_all this `all l (R b)`,
+        trans `R a b` `R b x`))
+-/
+
+theorem strongly_sorted_of_sorted_of_transitive (trans : transitive R) : ∀ {l}, sorted R l → strongly_sorted R l
+| []     h := strongly_sorted.base R
+| (a::l) h :=
+  have sorted R l,          from and.right (sorted_inv h),
+  have aux : strongly_sorted R l, from strongly_sorted_of_sorted_of_transitive this,
+  have all l (R a),         from sorted_extends trans h,
+  strongly_sorted.step this aux
+
+open perm
+
+lemma eq_of_sorted_of_perm (tr : transitive R) (anti : anti_symmetric R) : ∀ {l₁ l₂ : list A}, l₁ ~ l₂ → sorted R l₁ → sorted R l₂ → l₁ = l₂
+:= sorry
+/-
+| []       []       h₁ h₂ h₃ := rfl
+| (a₁::l₁) []       h₁ h₂ h₃ := absurd (perm.symm h₁) !not_perm_nil_cons
+| []       (a₂::l₂) h₁ h₂ h₃ := absurd h₁ !not_perm_nil_cons
+| (a::l₁)  l₂       h₁ h₂ h₃ :=
+  have aux : ∀ {t}, l₂ = a::t → a::l₁ = l₂, from
+    take t, suppose l₂ = a::t,
+    have l₁ ~ t,      by rewrite [this at h₁]; apply perm_cons_inv h₁,
+    have sorted R l₁, from and.right (sorted_inv h₂),
+    have sorted R t,  by rewrite [`l₂ = a::t` at h₃]; exact and.right (sorted_inv h₃),
+    have l₁ = t,      from eq_of_sorted_of_perm `l₁ ~ t` `sorted R l₁` `sorted R t`,
+    show a :: l₁ = l₂,  by rewrite [`l₂ = a::t`, this],
+  have   a ∈ l₂,                       from mem_perm h₁ !mem_cons,
+  obtain s t (e₁ : l₂ = s ++ (a::t)),  from mem_split this,
+  begin
+    cases s with b s,
+    { have l₂ = a::t, by exact e₁,
+      exact aux this },
+    { have e₁   : l₂ = b::(s++(a::t)), by exact e₁,
+      have b ∈ l₂,                by rewrite e₁; apply mem_cons,
+      have hall₂ : all (s++(a::t)) (R b), begin rewrite [e₁ at h₃], apply sorted_extends tr h₃ end,
+      have a ∈ s++(a::t),         from mem_append_right _ !mem_cons,
+      have R b a,                 from of_mem_of_all this hall₂,
+      have b ∈ a::l₁,             from mem_perm (perm.symm h₁) `b ∈ l₂`,
+      have hall₁ : all l₁ (R a),  from sorted_extends tr h₂,
+      apply or.elim (eq_or_mem_of_mem_cons `b ∈ a::l₁`),
+        suppose b = a,  by rewrite this at e₁; exact aux e₁,
+        suppose b ∈ l₁,
+          have R a b, from of_mem_of_all this hall₁,
+          have b = a, from anti `R b a` `R a b`,
+          by rewrite this at e₁; exact aux e₁ }
+  end
+-/
+end list

old_library/data/map.lean

@@ -0,0 +1,52 @@
+/-
+Copyright (c) 2016 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+-/
+definition map (A B : Type) := A → option B
+
+namespace map
+variables {A B : Type}
+open tactic
+
+definition empty : map A B :=
+λ a, none
+
+definition lookup (k : A) (m : map A B) : option B :=
+m k
+
+theorem ext (m₁ m₂ : map A B) : (∀ a, lookup a m₁ = lookup a m₂) → m₁ = m₂ :=
+funext
+
+theorem lookup_empty (k : A) : lookup k (empty : map A B) = none :=
+rfl
+
+variable [decidable_eq A]
+
+definition insert (k : A) (v : B) (m : map A B) : map A B :=
+λ a, if a = k then some v else m a
+
+theorem lookup_insert (k : A) (v : B) (m : map A B) : lookup k (insert k v m) = some v :=
+by unfold [`map.insert, `map.lookup] >> dsimp >> rewrite `if_pos >> reflexivity
+
+theorem lookup_insert_of_ne {k₁ k₂ : A} (v : B) (m : map A B) : k₁ ≠ k₂ → lookup k₁ (insert k₂ v m) = lookup k₁ m :=
+by intros >> unfold [`map.insert, `map.lookup] >> dsimp >> rewrite `if_neg >> assumption
+
+definition erase (k : A) (m : map A B) : map A B :=
+λ a, if a = k then none else m a
+
+theorem lookup_erase (k : A) (v : B) (m : map A B) : lookup k (erase k m) = none :=
+by unfold [`map.erase, `map.lookup] >> dsimp >> rewrite `if_pos >> reflexivity
+
+theorem lookup_erase_of_ne {k₁ k₂ : A} (v : B) (m : map A B) : k₁ ≠ k₂ → lookup k₁ (erase k₂ m) = lookup k₁ m :=
+by intros >> unfold [`map.erase, `map.lookup] >> dsimp >> rewrite `if_neg >> assumption
+
+theorem erase_empty (k : A) : erase k empty = (empty : map A B) :=
+funext (λ a, by unfold [`map.erase, `map.empty] >> rewrite `if_t_t)
+
+theorem erase_insert {k : A} {m : map A B} (v : B) : lookup k m = none → erase k (insert k v m) = m :=
+assume h, funext (λ a, decidable.by_cases
+  (suppose a = k, by get_local `this >>= subst >> unfold [`map.erase, `map.insert] >> rewrite `if_pos >> symmetry >> assumption >> reflexivity)
+  (suppose a ≠ k, by unfold [`map.erase, `map.insert] >> rewrite `if_neg >> dsimp >> rewrite `if_neg >> repeat assumption))
+
+end map

old_library/data/matrix.lean

@@ -0,0 +1,123 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+
+Matrices
+-/
+import algebra.ring data.fin data.fintype
+open fin nat
+
+attribute [reducible]
+definition matrix (A : Type) (m n : nat) := fin m → fin n → A
+
+namespace matrix
+variables {A B C : Type} {m n p : nat}
+
+attribute [reducible]
+definition val (M : matrix A m n) (i : fin m) (j : fin n) : A :=
+M i j
+
+namespace ops
+notation M `[` i `, ` j `]` := val M i j
+end ops
+
+open ops
+
+protected lemma ext {M N : matrix A m n} (h : ∀ i j, M[i,j] = N[i, j]) : M = N :=
+funext (λ i, funext (λ j, h i j))
+
+protected lemma has_decidable_eq [h : decidable_eq A] (m n : nat) : decidable_eq (matrix A m n) :=
+_
+
+definition to_matrix (f : fin m → fin n → A) : matrix A m n :=
+f
+
+definition map (f : A → B) (M : matrix A m n) : matrix B m n :=
+λ i j, f (M[i,j])
+
+definition map₂ (f : A → B → C) (M : matrix A m n) (N : matrix B m n) : matrix C m n :=
+λ i j, f (M[i, j]) (N[i,j])
+
+definition transpose (M : matrix A m n) : matrix A n m :=
+λ i j, M[j, i]
+
+definition symmetric (M : matrix A n n) :=
+transpose M = M
+
+section
+variable [r : comm_ring A]
+include r
+
+definition identity (n : nat) : matrix A n n :=
+λ i j, if i = j then 1 else 0
+
+definition I {n : nat} : matrix A n n :=
+identity n
+
+protected definition zero (m n : nat) : matrix A m n :=
+λ i j, 0
+
+protected definition add (M : matrix A m n) (N : matrix A m n) : matrix A m n :=
+λ i j, M[i, j] + N[i, j]
+
+protected definition sub (M : matrix A m n) (N : matrix A m n) : matrix A m n :=
+λ i j, M[i, j] - N[i, j]
+
+protected definition mul (M : matrix A m n) (N : matrix A n p) : matrix A m p :=
+λ i j, fin.foldl has_add.add 0 (λ k : fin n, M[i,k] * N[k,j])
+
+definition smul (a : A) (M : matrix A m n) : matrix A m n :=
+λ i j, a * M[i, j]
+
+attribute [instance]
+definition matrix_has_zero (m n : nat) : has_zero (matrix A m n) :=
+has_zero.mk (matrix.zero m n)
+
+attribute [instance]
+definition matrix_has_one (n : nat) : has_one (matrix A n n) :=
+has_one.mk (identity n)
+
+attribute [instance]
+definition matrix_has_add (m n : nat) : has_add (matrix A m n) :=
+has_add.mk matrix.add
+
+attribute [instance]
+definition matrix_has_mul (n : nat) : has_mul (matrix A n n) :=
+has_mul.mk matrix.mul
+
+infix ` × ` := mul
+infix `⬝`    := smul
+
+protected lemma add_zero (M : matrix A m n) : M + 0 = M :=
+matrix.ext (λ i j, !add_zero)
+
+protected lemma zero_add (M : matrix A m n) : 0 + M = M :=
+matrix.ext (λ i j, !zero_add)
+
+protected lemma add.comm (M : matrix A m n) (N : matrix A m n) : M + N = N + M :=
+matrix.ext (λ i j, !add.comm)
+
+protected lemma add.assoc (M : matrix A m n) (N : matrix A m n) (P : matrix A m n) : (M + N) + P = M + (N + P) :=
+matrix.ext (λ i j, !add.assoc)
+
+definition is_diagonal (M : matrix A n n) :=
+∀ i j, i = j ∨ M[i, j] = 0
+
+definition is_zero (M : matrix A m n) :=
+∀ i j, M[i, j] = 0
+
+definition is_upper_triangular (M : matrix A n n) :=
+∀ i j : fin n, i > j → M[i, j] = 0
+
+definition is_lower_triangular (M : matrix A n n) :=
+∀ i j : fin n, i < j → M[i, j] = 0
+
+definition inverse (M : matrix A n n) (N : matrix A n n) :=
+M * N = I ∧ N * M = I
+
+definition invertible (M : matrix A n n) :=
+∃ N, inverse M N
+
+end
+end matrix

old_library/data/nat/basic.lean

@@ -0,0 +1,288 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad
+
+Basic operations on the natural numbers.
+-/
+import ..num algebra.ring
+open binary
+
+namespace nat
+
+/- a variant of add, defined by recursion on the first argument -/
+
+definition addl (x y : ℕ) : ℕ :=
+nat.rec y (λ n r, succ r) x
+infix ` ⊕ `:65 := addl
+
+theorem addl_succ_right (n m : ℕ) : n ⊕ succ m = succ (n ⊕ m) :=
+nat.induction_on n
+  rfl
+  (λ n₁ ih, calc
+    succ n₁ ⊕ succ m = succ (n₁ ⊕ succ m)   : rfl
+             ...     = succ (succ (n₁ ⊕ m)) : sorry -- by rewrite ih
+             ...     = succ (succ n₁ ⊕ m)   : rfl)
+
+theorem add_eq_addl (x : ℕ) : ∀y, x + y = x ⊕ y :=
+nat.induction_on x
+  (λ y, nat.induction_on y
+    rfl
+    (λ y₁ ih, calc
+      0 + succ y₁ = succ (0 + y₁)  : rfl
+           ...    = succ (0 ⊕ y₁) : sorry -- by rewrite ih
+           ...    = 0 ⊕ (succ y₁) : rfl))
+  (λ x₁ ih₁ y, nat.induction_on y
+    (calc
+      succ x₁ + 0  = succ (x₁ + 0)  : rfl
+               ... = succ (x₁ ⊕ 0) : sorry -- by rewrite (ih₁ 0)
+               ... = succ x₁ ⊕ 0   : rfl)
+    (λ y₁ ih₂, calc
+      succ x₁ + succ y₁ = succ (succ x₁ + y₁) : rfl
+                   ...  = succ (succ x₁ ⊕ y₁) : sorry -- by rewrite ih₂
+                   ...  = succ x₁ ⊕ succ y₁   : eq.symm $ addl_succ_right (succ x₁) y₁))
+
+/- successor and predecessor -/
+
+attribute [simp]
+theorem succ_ne_zero (n : ℕ) : succ n ≠ 0 :=
+sorry -- by contradiction
+
+attribute [simp]
+theorem add_one_ne_zero (n : ℕ) : n + 1 ≠ 0 :=
+sorry -- by contradiction
+
+-- add_rewrite succ_ne_zero
+
+attribute [simp]
+theorem pred_zero : pred 0 = 0 :=
+rfl
+
+attribute [simp]
+theorem pred_succ (n : ℕ) : pred (succ n) = n :=
+rfl
+
+theorem eq_zero_or_eq_succ_pred (n : ℕ) : n = 0 ∨ n = succ (pred n) :=
+nat.induction_on n
+  (or.inl rfl)
+  (take m IH, or.inr
+    (show succ m = succ (pred (succ m)), from congr_arg succ (eq.symm $ pred_succ m)))
+
+theorem exists_eq_succ_of_ne_zero {n : ℕ} (H : n ≠ 0) : ∃k : ℕ, n = succ k :=
+exists.intro _ (or_resolve_right (eq_zero_or_eq_succ_pred n) H)
+
+theorem succ.inj {n m : ℕ} (H : succ n = succ m) : n = m :=
+nat.no_confusion H imp.id
+
+abbreviation eq_of_succ_eq_succ := @succ.inj
+
+theorem succ_ne_self {n : ℕ} : succ n ≠ n :=
+nat.induction_on n
+  (take H : 1 = 0,
+    have ne : 1 ≠ 0, from succ_ne_zero 0,
+    absurd H ne)
+  (take k IH H, IH (succ.inj H))
+
+theorem discriminate {B : Prop} {n : ℕ} (H1: n = 0 → B) (H2 : ∀m, n = succ m → B) : B :=
+have H : n = n → B, from nat.cases_on n H1 H2,
+H rfl
+
+theorem two_step_induction_on {P : ℕ → Prop} (a : ℕ) (H1 : P 0) (H2 : P 1)
+    (H3 : ∀ (n : ℕ) (IH1 : P n) (IH2 : P (succ n)), P (succ (succ n))) : P a :=
+have stronger : P a ∧ P (succ a), from
+  nat.induction_on a
+    (and.intro H1 H2)
+    (take k IH,
+      have IH1 : P k, from and.elim_left IH,
+      have IH2 : P (succ k), from and.elim_right IH,
+        and.intro IH2 (H3 k IH1 IH2)),
+  and.elim_left stronger
+
+theorem sub_induction {P : ℕ → ℕ → Prop} (n m : ℕ) (H1 : ∀m, P 0 m)
+   (H2 : ∀n, P (succ n) 0) (H3 : ∀n m, P n m → P (succ n) (succ m)) : P n m :=
+have general : ∀m, P n m, from nat.induction_on n H1
+  (take k : ℕ,
+    assume IH : ∀m, P k m,
+    take m : ℕ,
+    nat.cases_on m (H2 k) (take l, (H3 k l (IH l)))),
+general m
+
+/- addition -/
+
+protected theorem add_zero (n : ℕ) : n + 0 = n :=
+rfl
+
+theorem add_succ (n m : ℕ) : n + succ m = succ (n + m) :=
+rfl
+
+/-
+Remark: we use 'local attributes' because in the end of the file
+we show not is a comm_semiring, and we will automatically inherit
+the associated [simp] lemmas from algebra
+-/
+local attribute nat.add_zero nat.add_succ [simp]
+
+protected theorem zero_add (n : ℕ) : 0 + n = n :=
+sorry -- by rec_simp
+
+theorem succ_add (n m : ℕ) : (succ n) + m = succ (n + m) :=
+sorry -- by rec_simp
+
+local attribute nat.zero_add nat.succ_add [simp]
+
+protected theorem add_comm (n m : ℕ) : n + m = m + n :=
+sorry -- by rec_simp
+
+theorem succ_add_eq_succ_add (n m : ℕ) : succ n + m = n + succ m :=
+sorry -- by simp
+
+protected theorem add_assoc (n m k : ℕ) : (n + m) + k = n + (m + k) :=
+sorry -- by rec_simp
+
+protected theorem add_left_comm : Π (n m k : ℕ), n + (m + k) = m + (n + k) :=
+left_comm nat.add_comm nat.add_assoc
+
+local attribute nat.add_comm nat.add_assoc nat.add_left_comm [simp]
+
+protected theorem add_right_comm : Π (n m k : ℕ), n + m + k = n + k + m :=
+right_comm nat.add_comm nat.add_assoc
+
+protected theorem add_left_cancel {n m k : ℕ} : n + m = n + k → m = k :=
+sorry
+/-
+nat.induction_on n
+  (by simp)
+  (take a iH,
+    -- TODO(Leo): replace with forward reasoning after we add strategies for it.
+    have succ (a + m) = succ (a + k) → a + m = a + k, from !succ.inj,
+    by inst_simp)
+-/
+
+protected theorem add_right_cancel {n m k : ℕ} (H : n + m = k + m) : n = k :=
+sorry
+/-
+have H2 : m + n = m + k, by simp,
+nat.add_left_cancel H2
+-/
+
+theorem eq_zero_of_add_eq_zero_right {n m : ℕ} : n + m = 0 → n = 0 :=
+sorry
+/-
+nat.induction_on n
+  (by simp)
+  (take k iH, assume H : succ k + m = 0,
+    absurd
+      (show succ (k + m) = 0, by simp)
+      !succ_ne_zero)
+-/
+
+theorem eq_zero_of_add_eq_zero_left {n m : ℕ} (H : n + m = 0) : m = 0 :=
+eq_zero_of_add_eq_zero_right (eq.trans (nat.add_comm m n) H)
+
+theorem eq_zero_and_eq_zero_of_add_eq_zero {n m : ℕ} (H : n + m = 0) : n = 0 ∧ m = 0 :=
+and.intro (eq_zero_of_add_eq_zero_right H) (eq_zero_of_add_eq_zero_left H)
+
+theorem add_one (n : ℕ) : n + 1 = succ n := rfl
+
+local attribute add_one [simp]
+
+theorem one_add (n : ℕ) : 1 + n = succ n :=
+sorry -- by simp
+
+theorem succ_eq_add_one (n : ℕ) : succ n = n + 1 :=
+rfl
+
+/- multiplication -/
+
+protected theorem mul_zero (n : ℕ) : n * 0 = 0 :=
+rfl
+
+theorem mul_succ (n m : ℕ) : n * succ m = n * m + n :=
+rfl
+
+local attribute nat.mul_zero nat.mul_succ [simp]
+
+-- commutativity, distributivity, associativity, identity
+
+protected theorem zero_mul (n : ℕ) : 0 * n = 0 :=
+sorry -- by rec_simp
+
+theorem succ_mul (n m : ℕ) : (succ n) * m = (n * m) + m :=
+sorry -- by rec_simp
+
+local attribute nat.zero_mul nat.succ_mul [simp]
+
+protected theorem mul_comm (n m : ℕ) : n * m = m * n :=
+sorry -- by rec_simp
+
+protected theorem right_distrib (n m k : ℕ) : (n + m) * k = n * k + m * k :=
+sorry -- by rec_simp
+
+protected theorem left_distrib (n m k : ℕ) : n * (m + k) = n * m + n * k :=
+sorry -- by rec_simp
+
+local attribute nat.mul_comm nat.right_distrib nat.left_distrib [simp]
+
+protected theorem mul_assoc (n m k : ℕ) : (n * m) * k = n * (m * k) :=
+sorry -- by rec_simp
+
+local attribute nat.mul_assoc [simp]
+
+protected theorem mul_one (n : ℕ) : n * 1 = n :=
+sorry
+/-
+calc
+  n * 1 = n * 0 + n : !mul_succ
+    ... = n         : by simp
+-/
+
+local attribute nat.mul_one [simp]
+
+protected theorem one_mul (n : ℕ) : 1 * n = n :=
+sorry -- by simp
+
+local attribute nat.one_mul [simp]
+
+theorem eq_zero_or_eq_zero_of_mul_eq_zero {n m : ℕ} : n * m = 0 → n = 0 ∨ m = 0 :=
+sorry
+/-
+nat.cases_on n (by simp)
+  (take n',
+    nat.cases_on m
+      (by simp)
+      (take m', assume H,
+        absurd
+          (show succ (succ n' * m' + n') = 0, by simp)
+          !succ_ne_zero))
+-/
+
+attribute [instance]
+protected definition comm_semiring : comm_semiring nat :=
+⦃comm_semiring,
+ add            := nat.add,
+ add_assoc      := nat.add_assoc,
+ zero           := nat.zero,
+ zero_add       := nat.zero_add,
+ add_zero       := nat.add_zero,
+ add_comm       := nat.add_comm,
+ mul            := nat.mul,
+ mul_assoc      := nat.mul_assoc,
+ one            := nat.succ nat.zero,
+ one_mul        := nat.one_mul,
+ mul_one        := nat.mul_one,
+ left_distrib   := nat.left_distrib,
+ right_distrib  := nat.right_distrib,
+ zero_mul       := nat.zero_mul,
+ mul_zero       := nat.mul_zero,
+ mul_comm       := nat.mul_comm⦄
+
+end nat
+
+section
+open nat
+definition iterate {A : Type} (op : A → A) : ℕ → A → A
+ | 0 := λ a, a
+ | (succ k) := λ a, op (iterate k a)
+
+notation f`^[`n`]` := iterate f n
+end

old_library/data/nat/bigops.lean

@@ -0,0 +1,197 @@
+/-
+Copyright (c) 2015 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+
+Finite sums and products over intervals of natural numbers.
+-/
+-- TODO(Leo): remove after refactoring
+exit
+import data.nat.order algebra.group_bigops algebra.interval
+
+namespace nat
+
+/- sums -/
+
+section add_monoid
+
+variables {A : Type} [add_monoid A]
+
+definition sum_up_to (n : ℕ) (f : ℕ → A) : A :=
+  nat.rec_on n 0 (λ n a, a + f n)
+
+notation `∑` binders ` < ` n `, ` r:(scoped f, sum_up_to n f) := r
+
+proposition sum_up_to_zero (f : ℕ → A) : (∑ i < 0, f i) = 0 := rfl
+
+proposition sum_up_to_succ (n : ℕ) (f : ℕ → A) : (∑ i < succ n, f i) = (∑ i < n, f i) + f n := rfl
+
+proposition sum_up_to_one (f : ℕ → A) : (∑ i < 1, f i) = f 0 := zero_add (f 0)
+
+definition sum_range (m n : ℕ) (f : ℕ → A) : A := sum_up_to (succ n - m) (λ i, f (i + m))
+
+notation `∑` binders `=` m `...` n `, ` r:(scoped f, sum_range m n f) := r
+
+proposition sum_range_def (m n : ℕ) (f : ℕ → A) :
+            (∑ i = m...n, f i) = (∑ i < (succ n - m), f (i + m)) := rfl
+
+proposition sum_range_self (m : ℕ) (f : ℕ → A) :
+            (∑ i = m...m, f i) = f m :=
+  by krewrite [↑sum_range, succ_sub !le.refl, nat.sub_self, sum_up_to_one, zero_add]
+
+proposition sum_range_succ {m n : ℕ} (f : ℕ → A) (H : m ≤ succ n) :
+            (∑ i = m...succ n, f i) = (∑ i = m...n, f i) + f (succ n) :=
+  by rewrite [↑sum_range, succ_sub H, sum_up_to_succ, nat.sub_add_cancel H]
+
+proposition sum_up_to_succ_eq_sum_range_zero (n : ℕ) (f : ℕ → A) :
+            (∑ i < succ n, f i) = (∑ i = 0...n, f i) := rfl
+
+end add_monoid
+
+section finset
+  variables {A : Type} [add_comm_monoid A]
+  open finset
+
+proposition sum_up_to_eq_Sum_upto (n : ℕ) (f : ℕ → A) :
+            (∑ i < n, f i) = (∑ i ∈ upto n, f i) :=
+begin
+  induction n with n ih,
+    {exact rfl},
+  have H : upto n ∩ '{n} = ∅, from
+    inter_eq_empty
+      (take x,
+        suppose x ∈ upto n,
+        have x < n, from lt_of_mem_upto this,
+        suppose x ∈ '{n},
+        have x = n, by rewrite -mem_singleton_iff; apply this,
+        have n < n, from eq.subst this `x < n`,
+        show false, from !lt.irrefl this),
+  rewrite [sum_up_to_succ, ih, upto_succ, Sum_union _ H, Sum_singleton]
+end
+
+end finset
+
+section set
+  variables {A : Type} [add_comm_monoid A]
+  open set interval
+
+proposition sum_range_eq_sum_interval_aux (m n : ℕ) (f : ℕ → A) :
+            (∑ i = m...m+n, f i) = (∑ i ∈ '[m, m + n], f i) :=
+begin
+  induction n with n ih,
+    {krewrite [nat.add_zero, sum_range_self, Icc_self, Sum_singleton]},
+  have H : m ≤ succ (m + n), from le_of_lt (lt_of_le_of_lt !le_add_right !lt_succ_self),
+  have H' : '[m, m + n] ∩ '{succ (m + n)} = ∅, from
+    eq_empty_of_forall_not_mem (take x, assume H1,
+      have x = succ (m + n), from eq_of_mem_singleton (and.right H1),
+      have succ (m + n) ≤ m + n, from eq.subst this (and.right (and.left H1)),
+      show false, from not_lt_of_ge this !lt_succ_self),
+  rewrite [add_succ, sum_range_succ f H, Icc_eq_Icc_union_Ioc !le_add_right !le_succ,
+           nat.Ioc_eq_Icc_succ, Icc_self, Sum_union f H', Sum_singleton, ih]
+end
+
+proposition sum_range_eq_sum_interval {m n : ℕ} (f : ℕ → A) (H : m ≤ n) :
+            (∑ i = m...n, f i) = (∑ i ∈ '[m, n], f i) :=
+  have n = m + (n - m), by rewrite [add.comm, nat.sub_add_cancel H],
+  using this, by rewrite this; apply sum_range_eq_sum_interval_aux
+
+proposition sum_range_offset (m n : ℕ) (f : ℕ → A) :
+            (∑ i = m...m+n, f i) = (∑ i = 0...n, f (m + i)) :=
+  have bij_on (add m) ('[0, n]) ('[m, m+n]), from !nat.bij_on_add_Icc_zero,
+  by rewrite [-zero_add n at {2}, *sum_range_eq_sum_interval_aux, Sum_eq_of_bij_on f this, zero_add]
+
+end set
+
+/- products -/
+
+section monoid
+
+variables {A : Type} [monoid A]
+
+definition prod_up_to (n : ℕ) (f : ℕ → A) : A :=
+  nat.rec_on n 1 (λ n a, a * f n)
+
+notation `∏` binders ` < ` n `, ` r:(scoped f, prod_up_to n f) := r
+
+proposition prod_up_to_zero (f : ℕ → A) : (∏ i < 0, f i) = 1 := rfl
+
+proposition prod_up_to_succ (n : ℕ) (f : ℕ → A) : (∏ i < succ n, f i) = (∏ i < n, f i) * f n := rfl
+
+proposition prod_up_to_one (f : ℕ → A) : (∏ i < 1, f i) = f 0 := one_mul (f 0)
+
+definition prod_range (m n : ℕ) (f : ℕ → A) : A := prod_up_to (succ n - m) (λ i, f (i + m))
+
+notation `∏` binders `=` m `...` n `, ` r:(scoped f, prod_range m n f) := r
+
+proposition prod_range_def (m n : ℕ) (f : ℕ → A) :
+            (∏ i = m...n, f i) = (∏ i < (succ n - m), f (i + m)) := rfl
+
+proposition prod_range_self (m : ℕ) (f : ℕ → A) :
+            (∏ i = m...m, f i) = f m :=
+by krewrite [↑prod_range, succ_sub !le.refl, nat.sub_self, prod_up_to_one, zero_add]
+
+proposition prod_range_succ {m n : ℕ} (f : ℕ → A) (H : m ≤ succ n) :
+            (∏ i = m...succ n, f i) = (∏ i = m...n, f i) * f (succ n) :=
+by rewrite [↑prod_range, succ_sub H, prod_up_to_succ, nat.sub_add_cancel H]
+
+proposition prod_up_to_succ_eq_prod_range_zero (n : ℕ) (f : ℕ → A) :
+            (∏ i < succ n, f i) = (∏ i = 0...n, f i) := rfl
+
+end monoid
+
+section finset
+  variables {A : Type} [comm_monoid A]
+  open finset
+
+proposition prod_up_to_eq_Prod_upto (n : ℕ) (f : ℕ → A) :
+            (∏ i < n, f i) = (∏ i ∈ upto n, f i) :=
+begin
+  induction n with n ih,
+    {exact rfl},
+  have H : upto n ∩ '{n} = ∅, from
+    inter_eq_empty
+      (take x,
+        suppose x ∈ upto n,
+        have x < n, from lt_of_mem_upto this,
+        suppose x ∈ '{n},
+        have x = n, by rewrite -mem_singleton_iff; apply this,
+        have n < n, from eq.subst this `x < n`,
+        show false, from !lt.irrefl this),
+  rewrite [prod_up_to_succ, ih, upto_succ, Prod_union _ H, Prod_singleton]
+end
+
+end finset
+
+section set
+  variables {A : Type} [comm_monoid A]
+  open set interval
+
+proposition prod_range_eq_prod_interval_aux (m n : ℕ) (f : ℕ → A) :
+            (∏ i = m...m+n, f i) = (∏ i ∈ '[m, m + n], f i) :=
+begin
+  induction n with n ih,
+    {krewrite [nat.add_zero, prod_range_self, Icc_self, Prod_singleton]},
+  have H : m ≤ succ (m + n), from le_of_lt (lt_of_le_of_lt !le_add_right !lt_succ_self),
+  have H' : '[m, m + n] ∩ '{succ (m + n)} = ∅, from
+    eq_empty_of_forall_not_mem (take x, assume H1,
+      have x = succ (m + n), from eq_of_mem_singleton (and.right H1),
+      have succ (m + n) ≤ m + n, from eq.subst this (and.right (and.left H1)),
+      show false, from not_lt_of_ge this !lt_succ_self),
+  rewrite [add_succ, prod_range_succ f H, Icc_eq_Icc_union_Ioc !le_add_right !le_succ,
+           nat.Ioc_eq_Icc_succ, Icc_self, Prod_union f H', Prod_singleton, ih]
+end
+
+proposition prod_range_eq_prod_interval {m n : ℕ} (f : ℕ → A) (H : m ≤ n) :
+            (∏ i = m...n, f i) = (∏ i ∈ '[m, n], f i) :=
+  have n = m + (n - m), by rewrite [add.comm, nat.sub_add_cancel H],
+  using this, by rewrite this; apply prod_range_eq_prod_interval_aux
+
+proposition prod_range_offset (m n : ℕ) (f : ℕ → A) :
+            (∏ i = m...m+n, f i) = (∏ i = 0...n, f (m + i)) :=
+  have bij_on (add m) ('[0, n]) ('[m, m+n]), from !nat.bij_on_add_Icc_zero,
+  by rewrite [-zero_add n at {2}, *prod_range_eq_prod_interval_aux, Prod_eq_of_bij_on f this,
+              zero_add]
+
+end set
+
+end nat

old_library/data/nat/bquant.lean

@@ -0,0 +1,159 @@
+/-
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+
+Show that "bounded" quantifiers: (∃x, x < n ∧ P x) and (∀x, x < n → P x)
+are decidable when P is decidable.
+
+This module allow us to write if-then-else expressions such as
+
+  if (∀ x : nat, x < n → ∃ y : nat, y < n ∧ y * y = x) then t else s
+
+without assuming classical axioms.
+
+More importantly, they can be reduced inside of the Lean kernel.
+-/
+import data.nat.order data.nat.div
+
+namespace nat
+  open subtype
+
+  attribute [reducible]
+  definition bex (n : nat) (P : nat → Prop) : Prop :=
+  ∃ x, x < n ∧ P x
+
+  attribute [reducible]
+  definition bsub (n : nat) (P : nat → Prop) : Type₁ :=
+  {x \ x < n ∧ P x}
+
+  attribute [reducible]
+  definition ball (n : nat) (P : nat → Prop) : Prop :=
+  ∀ x, x < n → P x
+
+  lemma bex_of_bsub {n : nat} {P : nat → Prop} : bsub n P → bex n P :=
+  assume h, exists_of_subtype h
+
+  theorem not_bex_zero (P : nat → Prop) : ¬ bex 0 P :=
+  sorry
+  /-
+  λ H, obtain (w : nat) (Hw : w < 0 ∧ P w), from H,
+    and.rec_on Hw (λ h₁ h₂, absurd h₁ (not_lt_zero w))
+  -/
+
+  theorem not_bsub_zero (P : nat → Prop) : bsub 0 P → false :=
+  λ H, absurd (bex_of_bsub H) (not_bex_zero P)
+
+  definition bsub_succ {P : nat → Prop} {n : nat} (H : bsub n P) : bsub (succ n) P :=
+  subtype.rec_on H (λ w Hw, tag w (and.rec_on Hw (λ hlt hp, and.intro (lt.step hlt) hp)))
+
+  theorem bex_succ {P : nat → Prop} {n : nat} (H : bex n P) : bex (succ n) P :=
+  sorry
+  /-
+  obtain (w : nat) (Hw : w < n ∧ P w), from H,
+    and.rec_on Hw (λ hlt hp, exists.intro w (and.intro (lt.step hlt) hp))
+  -/
+
+  definition bsub_succ_of_pred {P : nat → Prop} {a : nat} (H : P a) : bsub (succ a) P :=
+  tag a (and.intro (lt.base a) H)
+
+  theorem bex_succ_of_pred {P : nat → Prop} {a : nat} (H : P a) : bex (succ a) P :=
+  bex_of_bsub (bsub_succ_of_pred H)
+
+  theorem not_bex_succ {P : nat → Prop} {n : nat} (H₁ : ¬ bex n P) (H₂ : ¬ P n) : ¬ bex (succ n) P :=
+  sorry
+  /-
+  λ H, obtain (w : nat) (Hw : w < succ n ∧ P w), from H,
+    and.rec_on Hw (λ hltsn hp, or.rec_on (nat.eq_or_lt_of_le (le_of_succ_le_succ hltsn))
+      (λ heq : w = n, absurd (eq.rec_on heq hp) H₂)
+      (λ hltn : w < n, absurd (exists.intro w (and.intro hltn hp)) H₁))
+  -/
+
+  theorem not_bsub_succ {P : nat → Prop} {n : nat} (H₁ : ¬ bex n P) (H₂ : ¬ P n) : bsub (succ n) P → false :=
+  λ H, absurd (bex_of_bsub H) (not_bex_succ H₁ H₂)
+
+  theorem ball_zero (P : nat → Prop) : ball zero P :=
+  λ x Hlt, absurd Hlt (not_lt_zero x)
+
+  theorem ball_of_ball_succ {n : nat} {P : nat → Prop} (H : ball (succ n) P) : ball n P  :=
+  λ x Hlt, H x (lt.step Hlt)
+
+  theorem ball_succ_of_ball {n : nat} {P : nat → Prop} (H₁ : ball n P) (H₂ : P n) : ball (succ n) P :=
+  λ (x : nat) (Hlt : x < succ n), or.elim (nat.eq_or_lt_of_le (le_of_succ_le_succ Hlt))
+    (λ heq : x = n, eq.rec_on (eq.rec_on heq rfl) H₂)
+    (λ hlt : x < n, H₁ x hlt)
+
+  theorem not_ball_of_not {n : nat} {P : nat → Prop} (H₁ : ¬ P n) : ¬ ball (succ n) P :=
+  λ (H : ball (succ n) P), absurd (H n (lt.base n)) H₁
+
+  theorem not_ball_succ_of_not_ball {n : nat} {P : nat → Prop} (H₁ : ¬ ball n P) : ¬ ball (succ n) P :=
+  λ (H : ball (succ n) P), absurd (ball_of_ball_succ H) H₁
+end nat
+
+section
+  open nat decidable
+
+  attribute [instance]
+  definition decidable_bex (n : nat) (P : nat → Prop) [H : decidable_pred P] : decidable (bex n P) :=
+  nat.rec_on n
+    (ff (not_bex_zero P))
+    (λ a ih, decidable.rec_on ih
+      (λ hneg : ¬ bex a P, decidable.rec_on (H a)
+         (λ hna : ¬ P a, ff (not_bex_succ hneg hna))
+         (λ hpa : P a, tt (bex_succ_of_pred hpa)))
+      (λ hpos : bex a P, tt (bex_succ hpos)))
+
+  attribute [instance]
+  definition decidable_ball (n : nat) (P : nat → Prop) [H : decidable_pred P] : decidable (ball n P) :=
+  nat.rec_on n
+    (tt (ball_zero P))
+    (λ n₁ ih, decidable.rec_on ih
+      (λ ih_neg, ff (not_ball_succ_of_not_ball ih_neg))
+      (λ ih_pos, decidable.rec_on (H n₁)
+         (λ p_neg, ff (not_ball_of_not p_neg))
+         (λ p_pos, tt (ball_succ_of_ball ih_pos p_pos))))
+
+  attribute [instance]
+  definition decidable_bex_le (n : nat) (P : nat → Prop) [decidable_pred P]
+    : decidable (∃ x, x ≤ n ∧ P x) :=
+  decidable_of_decidable_of_iff
+    (decidable_bex (succ n) P)
+    (exists_congr (λn', and_congr (lt_succ_iff_le n' n) (iff.refl (P n'))))
+
+  attribute [instance]
+  definition decidable_ball_le (n : nat) (P : nat → Prop) [decidable_pred P]
+    : decidable (∀ x, x ≤ n → P x) :=
+  decidable_of_decidable_of_iff
+    (decidable_ball (succ n) P)
+    (forall_congr (λ n', imp_congr (lt_succ_iff_le n' n) (iff.refl (P n'))))
+end
+
+namespace nat
+  open decidable subtype
+  variable {P : nat → Prop}
+  variable [decP : decidable_pred P]
+  include decP
+
+  definition bsub_not_of_not_ball : ∀ {n : nat}, ¬ ball n P → {i \ i < n ∧ ¬ P i}
+  | 0        h := absurd (ball_zero P) h
+  | (succ n) h := decidable.by_cases
+    (λ hp : P n,
+      have ¬ ball n P, from
+        assume b : ball n P, absurd (ball_succ_of_ball b hp) h,
+      have {i \ i < n ∧ ¬ P i}, from bsub_not_of_not_ball this,
+      bsub_succ this)
+    (λ hn : ¬ P n, bsub_succ_of_pred hn)
+
+  theorem bex_not_of_not_ball {n : nat} (H : ¬ ball n P) : bex n (λ n, ¬ P n) :=
+  bex_of_bsub (bsub_not_of_not_ball H)
+
+  theorem ball_not_of_not_bex : ∀ {n : nat}, ¬ bex n P → ball n (λ n, ¬ P n)
+  | 0        h := ball_zero _
+  | (succ n) h := by_cases
+    (λ hp : P n, absurd (bex_succ_of_pred hp) h)
+    (λ hn : ¬ P n,
+      have ¬ bex n P, from
+        assume b : bex n P, absurd (bex_succ b) h,
+      have ball n (λ n, ¬ P n), from ball_not_of_not_bex this,
+      ball_succ_of_ball this hn)
+end nat

old_library/data/nat/default.lean

@@ -0,0 +1,6 @@
+/-
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Jeremy Avigad
+-/
+import .basic .order .sub .div .gcd .bquant .sqrt .pairing .power .find .fact .parity

old_library/data/nat/div.lean

@@ -0,0 +1,730 @@
+/-
+Copyright (c) 2014 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad, Leonardo de Moura
+
+Definitions and properties of div and mod. Much of the development follows Isabelle's library.
+-/
+import .sub
+open well_founded decidable prod
+
+namespace nat
+
+/- div -/
+
+-- auxiliary lemma used to justify div
+private definition div_rec_lemma {x y : nat} : 0 < y ∧ y ≤ x → x - y < x :=
+and.rec (λ ypos ylex, sub_lt (lt_of_lt_of_le ypos ylex) ypos)
+
+private definition div.F (x : nat) (f : Π x₁, x₁ < x → nat → nat) (y : nat) : nat :=
+if H : 0 < y ∧ y ≤ x then f (x - y) (div_rec_lemma H) y + 1 else zero
+
+protected definition div := fix lt_wf div.F
+
+definition nat_has_divide : has_div nat :=
+has_div.mk nat.div
+
+local attribute [instance] nat_has_divide
+
+theorem div_def (x y : nat) : div x y = if 0 < y ∧ y ≤ x then div (x - y) y + 1 else 0 :=
+congr_fun (fix_eq lt_wf div.F x) y
+
+attribute [simp]
+protected theorem div_zero (a : ℕ) : a / 0 = 0 :=
+eq.trans (div_def a 0) $ if_neg (not_and_of_not_left (0 ≤ a) (lt.irrefl 0))
+
+theorem div_eq_zero_of_lt {a b : ℕ} (h : a < b) : a / b = 0 :=
+eq.trans (div_def a b) $ if_neg (not_and_of_not_right (0 < b) (not_le_of_gt h))
+
+attribute [simp]
+protected theorem zero_div (b : ℕ) : 0 / b = 0 :=
+eq.trans (div_def 0 b) $ if_neg (and.rec not_le_of_gt)
+
+theorem div_eq_succ_sub_div {a b : ℕ} (h₁ : b > 0) (h₂ : a ≥ b) : a / b = succ ((a - b) / b) :=
+eq.trans (div_def a b) $ if_pos (and.intro h₁ h₂)
+
+theorem add_div_self (x : ℕ) {z : ℕ} (H : z > 0) : (x + z) / z = succ (x / z) :=
+sorry
+/-
+calc
+  (x + z) / z = if 0 < z ∧ z ≤ x + z then (x + z - z) / z + 1 else 0 : !div_def
+            ... = (x + z - z) / z + 1 : if_pos (and.intro H (le_add_left z x))
+            ... = succ (x / z)        : by rewrite nat.add_sub_cancel
+-/
+
+theorem add_div_self_left {x : ℕ} (z : ℕ) (H : x > 0) : (x + z) / x = succ (z / x) :=
+add.comm z x ▸ add_div_self z H
+
+local attribute succ_mul [simp]
+
+theorem add_mul_div_self {x y z : ℕ} (H : z > 0) : (x + y * z) / z = x / z + y :=
+sorry
+/-
+nat.induction_on y
+  (by simp)
+  (take y,
+    assume IH : (x + y * z) / z = x / z + y, calc
+      (x + succ y * z) / z = (x + y * z + z) / z    : by inst_simp
+                       ... = succ ((x + y * z) / z) : !add_div_self H
+                       ... = succ (x / z + y)       : by rewrite IH)
+-/
+
+theorem add_mul_div_self_left (x z : ℕ) {y : ℕ} (H : y > 0) : (x + y * z) / y = x / y + z :=
+mul.comm z y ▸ add_mul_div_self H
+
+protected theorem mul_div_cancel (m : ℕ) {n : ℕ} (H : n > 0) : m * n / n = m :=
+sorry
+/-
+calc
+  m * n / n = (0 + m * n) / n : by simp
+          ... = 0 / n + m     : add_mul_div_self H
+          ... = m             : by simp
+-/
+
+protected theorem mul_div_cancel_left {m : ℕ} (n : ℕ) (H : m > 0) : m * n / m = n :=
+mul.comm n m ▸ nat.mul_div_cancel n H
+
+/- mod -/
+
+private definition mod.F (x : nat) (f : Π x₁, x₁ < x → nat → nat) (y : nat) : nat :=
+if H : 0 < y ∧ y ≤ x then f (x - y) (div_rec_lemma H) y else x
+
+protected definition mod := fix lt_wf mod.F
+
+definition nat_has_mod : has_mod nat :=
+has_mod.mk nat.mod
+
+local attribute [instance] nat_has_mod
+
+notation [priority nat.prio] a ≡ b `[mod `:0 c:0 `]` := a % c = b % c
+
+theorem mod_def (x y : nat) : mod x y = if 0 < y ∧ y ≤ x then mod (x - y) y else x :=
+congr_fun (fix_eq lt_wf mod.F x) y
+
+attribute [simp]
+theorem mod_zero (a : ℕ) : a % 0 = a :=
+eq.trans (mod_def a 0) $ if_neg (not_and_of_not_left (0 ≤ a) (lt.irrefl 0))
+
+theorem mod_eq_of_lt {a b : ℕ} (h : a < b) : a % b = a :=
+eq.trans (mod_def a b) $ if_neg (not_and_of_not_right (0 < b) (not_le_of_gt h))
+
+attribute [simp]
+theorem zero_mod (b : ℕ) : 0 % b = 0 :=
+eq.trans (mod_def 0 b) $ if_neg (λ h, and.rec_on h (λ l r, absurd (lt_of_lt_of_le l r) (lt.irrefl 0)))
+
+theorem mod_eq_sub_mod {a b : ℕ} (h₁ : b > 0) (h₂ : a ≥ b) : a % b = (a - b) % b :=
+eq.trans (mod_def a b) $ if_pos (and.intro h₁ h₂)
+
+attribute [simp]
+theorem add_mod_self (x z : ℕ) : (x + z) % z = x % z :=
+sorry
+/-
+by_cases_zero_pos z
+  (by rewrite add_zero)
+  (take z, assume H : z > 0,
+    calc
+      (x + z) % z = if 0 < z ∧ z ≤ x + z then (x + z - z) % z else _ : !mod_def
+                ... = (x + z - z) % z   : if_pos (and.intro H (le_add_left z x))
+                ... = x % z             : by rewrite nat.add_sub_cancel)
+-/
+
+attribute [simp]
+theorem add_mod_self_left (x z : ℕ) : (x + z) % x = z % x :=
+add.comm z x ▸ add_mod_self z x
+
+local attribute succ_mul [simp]
+
+attribute [simp]
+theorem add_mul_mod_self (x y z : ℕ) : (x + y * z) % z = x % z :=
+sorry -- nat.induction_on y (by simp) (by inst_simp)
+
+attribute [simp]
+theorem add_mul_mod_self_left (x y z : ℕ) : (x + y * z) % y = x % y :=
+sorry -- by inst_simp
+
+attribute [simp]
+theorem mul_mod_left (m n : ℕ) : (m * n) % n = 0 :=
+sorry
+/-
+calc (m * n) % n = (0 + m * n) % n : by simp
+            ...  = 0               : by inst_simp
+-/
+
+attribute [simp]
+theorem mul_mod_right (m n : ℕ) : (m * n) % m = 0 :=
+sorry -- by inst_simp
+
+theorem mod_lt (x : ℕ) {y : ℕ} (H : y > 0) : x % y < y :=
+nat.case_strong_induction_on x
+  (show 0 % y < y, from eq.symm (zero_mod y) ▸ H)
+  (take x,
+    assume IH : ∀x', x' ≤ x → x' % y < y,
+    show succ x % y < y, from
+      by_cases -- (succ x < y)
+        (assume H1 : succ x < y,
+          have succ x % y = succ x, from mod_eq_of_lt H1,
+          show succ x % y < y, from eq.symm this ▸ H1)
+        (assume H1 : ¬ succ x < y,
+          have y ≤ succ x, from le_of_not_gt H1,
+          have h : succ x % y = (succ x - y) % y, from mod_eq_sub_mod H this,
+          have succ x - y < succ x, from sub_lt (succ_pos x) H,
+          have succ x - y ≤ x, from le_of_lt_succ this,
+          show succ x % y < y, from eq.symm h ▸ IH _ this))
+
+theorem mod_one (n : ℕ) : n % 1 = 0 :=
+have H1 : n % 1 < 1, from (mod_lt n) (succ_pos 0),
+eq_zero_of_le_zero (le_of_lt_succ H1)
+
+/- properties of div and mod -/
+
+-- the quotient - remainder theorem
+theorem eq_div_mul_add_mod (x y : ℕ) : x = x / y * y + x % y :=
+sorry
+/-
+begin
+  eapply by_cases_zero_pos y,
+  show x = x / 0 * 0 + x % 0, from
+    (calc
+      x / 0 * 0 + x % 0 = 0 + x % 0 : by rewrite mul_zero
+        ... = x % 0                 : by rewrite zero_add
+        ... = x                     : by rewrite mod_zero)⁻¹,
+  intro y H,
+  show x = x / y * y + x % y,
+  begin
+    eapply nat.case_strong_induction_on x,
+    show 0 = (0 / y) * y + 0 % y, by rewrite [zero_mod, add_zero, nat.zero_div, zero_mul],
+    intro x IH,
+    show succ x = succ x / y * y + succ x % y, from
+      if H1 : succ x < y then
+         have H2 : succ x / y = 0, from div_eq_zero_of_lt H1,
+         have H3 : succ x % y = succ x, from mod_eq_of_lt H1,
+         begin rewrite [H2, H3, zero_mul, zero_add] end
+      else
+         have H2 : y ≤ succ x, from le_of_not_gt H1,
+         have H3 : succ x / y = succ ((succ x - y) / y), from div_eq_succ_sub_div H H2,
+         have H4 : succ x % y = (succ x - y) % y, from mod_eq_sub_mod H H2,
+         have H5 : succ x - y < succ x, from sub_lt !succ_pos H,
+         have H6 : succ x - y ≤ x, from le_of_lt_succ H5,
+         (calc
+             succ x / y * y + succ x % y =
+                  succ ((succ x - y) / y) * y + succ x % y      : by rewrite H3
+            ... = ((succ x - y) / y) * y + y + succ x % y       : by rewrite succ_mul
+            ... = ((succ x - y) / y) * y + y + (succ x - y) % y : by rewrite H4
+            ... = ((succ x - y) / y) * y + (succ x - y) % y + y : by rewrite add.right_comm
+            ... = succ x - y + y                                : by rewrite -(IH _ H6)
+            ... = succ x                                        : nat.sub_add_cancel H2)⁻¹
+  end
+end
+-/
+
+theorem mod_eq_sub_div_mul (x y : ℕ) : x % y = x - x / y * y :=
+nat.eq_sub_of_add_eq (eq.symm (add.comm (x / y * y) (x % y) ▸ eq_div_mul_add_mod x y))
+
+theorem mod_add_mod (m n k : ℕ) : (m % n + k) % n = (m + k) % n :=
+sorry -- by rewrite [eq_div_mul_add_mod m n at {2}, add.assoc, add.comm (m / n * n), add_mul_mod_self]
+
+theorem add_mod_mod (m n k : ℕ) : (m + n % k) % k = (m + n) % k :=
+sorry -- by rewrite [add.comm, mod_add_mod, add.comm]
+
+theorem add_mod_eq_add_mod_right {m n k : ℕ} (i : ℕ) (H : m % n = k % n) :
+  (m + i) % n = (k + i) % n :=
+sorry -- by rewrite [-mod_add_mod, -mod_add_mod k, H]
+
+theorem add_mod_eq_add_mod_left {m n k : ℕ} (i : ℕ) (H : m % n = k % n) :
+  (i + m) % n = (i + k) % n :=
+sorry -- by rewrite [add.comm, add_mod_eq_add_mod_right _ H, add.comm]
+
+theorem mod_eq_mod_of_add_mod_eq_add_mod_right {m n k i : ℕ} :
+  (m + i) % n = (k + i) % n → m % n = k % n :=
+sorry
+/-
+by_cases_zero_pos n
+  (by rewrite [*mod_zero]; apply eq_of_add_eq_add_right)
+  (take n,
+    assume npos : n > 0,
+    assume H1 : (m + i) % n = (k + i) % n,
+    have H2 : (m + i % n) % n = (k + i % n) % n, by rewrite [*add_mod_mod, H1],
+    have H3 : (m + i % n + (n - i % n)) % n = (k + i % n + (n - i % n)) % n,
+      from add_mod_eq_add_mod_right _ H2,
+    begin
+      revert H3,
+      rewrite [*add.assoc, add_sub_of_le (le_of_lt (!mod_lt npos)), *add_mod_self],
+      intros, assumption
+    end)
+-/
+
+theorem mod_eq_mod_of_add_mod_eq_add_mod_left {m n k i : ℕ} :
+  (i + m) % n = (i + k) % n → m % n = k % n :=
+sorry -- by rewrite [add.comm i m, add.comm i k]; apply mod_eq_mod_of_add_mod_eq_add_mod_right
+
+theorem mod_le {x y : ℕ} : x % y ≤ x :=
+eq.symm (eq_div_mul_add_mod x y) ▸ le_add_left (x % y) (x / y * y)
+
+theorem eq_remainder {q1 r1 q2 r2 y : ℕ} (H1 : r1 < y) (H2 : r2 < y)
+  (H3 : q1 * y + r1 = q2 * y + r2) : r1 = r2 :=
+sorry
+/-
+calc
+  r1 = r1 % y               : eq.symm (mod_eq_of_lt H1)
+    ... = (r1 + q1 * y) % y : !add_mul_mod_self⁻¹
+    ... = (q1 * y + r1) % y : by rewrite add.comm
+    ... = (r2 + q2 * y) % y : by rewrite [H3, add.comm]
+    ... = r2 % y            : !add_mul_mod_self
+    ... = r2                : mod_eq_of_lt H2
+-/
+
+theorem eq_quotient {q1 r1 q2 r2 y : ℕ} (H1 : r1 < y) (H2 : r2 < y)
+  (H3 : q1 * y + r1 = q2 * y + r2) : q1 = q2 :=
+have H4 : q1 * y + r2 = q2 * y + r2, from (eq_remainder H1 H2 H3) ▸ H3,
+have H5 : q1 * y = q2 * y, from add.right_cancel H4,
+have H6 : y > 0, from lt_of_le_of_lt (zero_le r1) H1,
+show q1 = q2, from eq_of_mul_eq_mul_right H6 H5
+
+protected theorem mul_div_mul_left {z : ℕ} (x y : ℕ) (zpos : z > 0) :
+  (z * x) / (z * y) = x / y :=
+sorry
+/-
+if H : y = 0 then
+  by rewrite [H, mul_zero, *nat.div_zero]
+else
+  have ypos : y > 0, from pos_of_ne_zero H,
+  have zypos : z * y > 0, from mul_pos zpos ypos,
+  have H1 : (z * x) % (z * y) < z * y, from !mod_lt zypos,
+  have H2 : z * (x % y) < z * y, from mul_lt_mul_of_pos_left (!mod_lt ypos) zpos,
+  eq_quotient H1 H2
+    (calc
+      ((z * x) / (z * y)) * (z * y) + (z * x) % (z * y) = z * x : by rewrite -eq_div_mul_add_mod
+        ... = z * (x / y * y + x % y)                           : by rewrite -eq_div_mul_add_mod
+        ... = z * (x / y * y) + z * (x % y)                     : !left_distrib
+        ... = (x / y) * (z * y) + z * (x % y)                   : by rewrite mul.left_comm)
+-/
+
+protected theorem mul_div_mul_right {x z y : ℕ} (zpos : z > 0) : (x * z) / (y * z) = x / y :=
+mul.comm z y ▸ mul.comm z x ▸ nat.mul_div_mul_left x y zpos
+
+theorem mul_mod_mul_left (z x y : ℕ) : (z * x) % (z * y) = z * (x % y) :=
+sorry
+/-
+or.elim (eq_zero_or_pos z)
+  (assume H : z = 0, H⁻¹ ▸ calc
+      (0 * x) % (z * y) = 0 % (z * y)   : by rewrite zero_mul
+                      ... = 0           : by rewrite zero_mod
+                      ... = 0 * (x % y) : by rewrite zero_mul)
+  (assume zpos : z > 0,
+    or.elim (eq_zero_or_pos y)
+      (assume H : y = 0, by rewrite [H, mul_zero, *mod_zero])
+      (assume ypos : y > 0,
+        have zypos : z * y > 0, from mul_pos zpos ypos,
+        have H1 : (z * x) % (z * y) < z * y, from !mod_lt zypos,
+        have H2 : z * (x % y) < z * y, from mul_lt_mul_of_pos_left (!mod_lt ypos) zpos,
+        eq_remainder H1 H2
+          (calc
+            ((z * x) / (z * y)) * (z * y) + (z * x) % (z * y) = z * x : by rewrite -eq_div_mul_add_mod
+              ... = z * (x / y * y + x % y)                           : by rewrite -eq_div_mul_add_mod
+              ... = z * (x / y * y) + z * (x % y)                     : by rewrite left_distrib
+              ... = (x / y) * (z * y) + z * (x % y)                   : by rewrite mul.left_comm)))
+-/
+
+theorem mul_mod_mul_right (x z y : ℕ) : (x * z) % (y * z) = (x % y) * z :=
+mul.comm z x ▸ mul.comm z y ▸ mul.comm z (x % y) ▸ mul_mod_mul_left z x y
+
+theorem mod_self (n : ℕ) : n % n = 0 :=
+sorry
+/-
+nat.cases_on n (by rewrite zero_mod)
+  (take n, by rewrite [-zero_add (succ n) at {1}, add_mod_self])
+-/
+
+theorem mul_mod_eq_mod_mul_mod (m n k : nat) : (m * n) % k = ((m % k) * n) % k :=
+sorry
+/-
+calc
+  (m * n) % k = (((m / k) * k + m % k) * n) % k : by rewrite -eq_div_mul_add_mod
+            ... = ((m % k) * n) % k             :
+                    by rewrite [right_distrib, mul.right_comm, add.comm, add_mul_mod_self]
+-/
+
+theorem mul_mod_eq_mul_mod_mod (m n k : nat) : (m * n) % k = (m * (n % k)) % k :=
+mul.comm (n % k) m ▸ mul.comm n m ▸ mul_mod_eq_mod_mul_mod n m k
+
+protected theorem div_one (n : ℕ) : n / 1 = n :=
+sorry
+/-
+have n / 1 * 1 + n % 1 = n, from !eq_div_mul_add_mod⁻¹,
+begin rewrite [-this at {2}, mul_one, mod_one] end
+-/
+
+protected theorem div_self {n : ℕ} (H : n > 0) : n / n = 1 :=
+sorry
+/-
+have (n * 1) / (n * 1) = 1 / 1, from !nat.mul_div_mul_left H,
+by rewrite [nat.div_one at this, -this, *mul_one]
+-/
+
+theorem div_mul_cancel_of_mod_eq_zero {m n : ℕ} (H : m % n = 0) : m / n * n = m :=
+sorry -- by rewrite [eq_div_mul_add_mod m n at {2}, H, add_zero]
+
+theorem mul_div_cancel_of_mod_eq_zero {m n : ℕ} (H : m % n = 0) : n * (m / n) = m :=
+mul.comm (m / n) n ▸ div_mul_cancel_of_mod_eq_zero H
+
+/- dvd -/
+
+theorem dvd_of_mod_eq_zero {m n : ℕ} (H : n % m = 0) : m ∣ n :=
+dvd.intro (mul.comm (n / m) m ▸ div_mul_cancel_of_mod_eq_zero H)
+
+theorem mod_eq_zero_of_dvd {m n : ℕ} (H : m ∣ n) : n % m = 0 :=
+dvd.elim H (take z, assume H1 : n = m * z, eq.symm H1 ▸ mul_mod_right m z)
+
+theorem dvd_iff_mod_eq_zero (m n : ℕ) : m ∣ n ↔ n % m = 0 :=
+iff.intro mod_eq_zero_of_dvd dvd_of_mod_eq_zero
+
+definition dvd.decidable_rel : decidable_rel dvd :=
+take m n, decidable_of_decidable_of_iff _ (iff.symm $ dvd_iff_mod_eq_zero m n)
+
+protected theorem div_mul_cancel {m n : ℕ} (H : n ∣ m) : m / n * n = m :=
+div_mul_cancel_of_mod_eq_zero (mod_eq_zero_of_dvd H)
+
+protected theorem mul_div_cancel' {m n : ℕ} (H : n ∣ m) : n * (m / n) = m :=
+mul.comm (m / n) n ▸ nat.div_mul_cancel H
+
+theorem dvd_of_dvd_add_left {m n₁ n₂ : ℕ} (H₁ : m ∣ n₁ + n₂) (H₂ : m ∣ n₁) : m ∣ n₂ :=
+sorry
+/-
+obtain (c₁ : nat) (Hc₁ : n₁ + n₂ = m * c₁), from H₁,
+obtain (c₂ : nat) (Hc₂ : n₁ = m * c₂), from H₂,
+have   aux : m * (c₁ - c₂) = n₂, from calc
+  m * (c₁ - c₂) = m * c₁  - m * c₂ : !nat.mul_sub_left_distrib
+           ...  = n₁ + n₂ - m * c₂ : by rewrite Hc₁
+           ...  = n₁ + n₂ - n₁     : by rewrite Hc₂
+           ...  = n₂               : !nat.add_sub_cancel_left,
+dvd.intro aux
+-/
+
+theorem dvd_of_dvd_add_right {m n₁ n₂ : ℕ} (H : m ∣ n₁ + n₂) : m ∣ n₂ → m ∣ n₁ :=
+nat.dvd_of_dvd_add_left (add.comm n₁ n₂ ▸ H)
+
+theorem dvd_sub {m n₁ n₂ : ℕ} (H1 : m ∣ n₁) (H2 : m ∣ n₂) : m ∣ n₁ - n₂ :=
+by_cases
+  (assume H3 : n₁ ≥ n₂,
+    have H4 : n₁ = n₁ - n₂ + n₂, from eq.symm (nat.sub_add_cancel H3),
+    show m ∣ n₁ - n₂, from nat.dvd_of_dvd_add_right (H4 ▸ H1) H2)
+  (assume H3 : ¬ (n₁ ≥ n₂),
+    have H4 : n₁ - n₂ = 0, from sub_eq_zero_of_le (le_of_lt (lt_of_not_ge H3)),
+    show m ∣ n₁ - n₂, from eq.symm H4 ▸ dvd_zero _)
+
+theorem dvd.antisymm {m n : ℕ} : m ∣ n → n ∣ m → m = n :=
+sorry
+/-
+by_cases_zero_pos n
+  (assume H1, assume H2 : 0 ∣ m, eq_zero_of_zero_dvd H2)
+  (take n,
+    assume Hpos : n > 0,
+    assume H1 : m ∣ n,
+    assume H2 : n ∣ m,
+    obtain k (Hk : n = m * k), from exists_eq_mul_right_of_dvd H1,
+    obtain l (Hl : m = n * l), from exists_eq_mul_right_of_dvd H2,
+    have n * (l * k) = n, from !mul.assoc ▸ Hl ▸ Hk⁻¹,
+    have l * k = 1,       from eq_one_of_mul_eq_self_right Hpos this,
+    have k = 1,           from eq_one_of_mul_eq_one_left this,
+    show m = n,           from (mul_one m)⁻¹ ⬝ (this ▸ Hk⁻¹))
+-/
+
+protected theorem mul_div_assoc (m : ℕ) {n k : ℕ} (H : k ∣ n) : m * n / k = m * (n / k) :=
+sorry
+/-
+or.elim (eq_zero_or_pos k)
+  (assume H1 : k = 0,
+    calc
+      m * n / k = m * n / 0     : by rewrite H1
+              ... = 0           : by rewrite nat.div_zero
+              ... = m * 0       : mul_zero m
+              ... = m * (n / 0) : by rewrite nat.div_zero
+              ... = m * (n / k) : by rewrite H1)
+  (assume H1 : k > 0,
+    have H2 : n = n / k * k, from (nat.div_mul_cancel H)⁻¹,
+      calc
+        m * n / k = m * (n / k * k) / k   : by rewrite -H2
+                ... = m * (n / k) * k / k : by rewrite mul.assoc
+                ... = m * (n / k)         : nat.mul_div_cancel _ H1)
+-/
+
+theorem dvd_of_mul_dvd_mul_left {m n k : ℕ} (kpos : k > 0) (H : k * m ∣ k * n) : m ∣ n :=
+dvd.elim H
+  (take l,
+    assume H1 : k * n = k * m * l,
+    have H2 : n = m * l, from eq_of_mul_eq_mul_left kpos (eq.trans H1 $ mul.assoc k m l),
+    dvd.intro (eq.symm H2))
+
+theorem dvd_of_mul_dvd_mul_right {m n k : ℕ} (kpos : k > 0) (H : m * k ∣ n * k) : m ∣ n :=
+nat.dvd_of_mul_dvd_mul_left kpos (mul.comm n k ▸ mul.comm m k ▸ H)
+
+lemma dvd_of_eq_mul (i j n : nat) : n = j*i → j ∣ n :=
+sorry -- begin intros, subst n, apply dvd_mul_right end
+
+theorem div_dvd_div {k m n : ℕ} (H1 : k ∣ m) (H2 : m ∣ n) : m / k ∣ n / k :=
+have H3 : m = m / k * k, from eq.symm (nat.div_mul_cancel H1),
+have H4 : n = n / k * k, from eq.symm (nat.div_mul_cancel (dvd.trans H1 H2)),
+or.elim (eq_zero_or_pos k)
+  (assume H5 : k = 0,
+    have H6: n / k = 0, from (eq.trans (congr_arg _ H5) $ nat.div_zero n),
+      eq.symm H6 ▸ dvd_zero (m / k))
+  (assume H5 : k > 0,
+    nat.dvd_of_mul_dvd_mul_right H5 (H3 ▸ H4 ▸ H2))
+
+protected theorem div_eq_iff_eq_mul_right {m n : ℕ} (k : ℕ) (H : n > 0) (H' : n ∣ m) :
+  m / n = k ↔ m = n * k :=
+sorry
+/-
+iff.intro
+  (assume H1, by rewrite [-H1, nat.mul_div_cancel' H'])
+  (assume H1, by rewrite [H1, !nat.mul_div_cancel_left H])
+-/
+
+protected theorem div_eq_iff_eq_mul_left {m n : ℕ} (k : ℕ) (H : n > 0) (H' : n ∣ m) :
+  m / n = k ↔ m = k * n :=
+mul.comm n k ▸ nat.div_eq_iff_eq_mul_right k H H'
+
+protected theorem eq_mul_of_div_eq_right {m n k : ℕ} (H1 : n ∣ m) (H2 : m / n = k) :
+  m = n * k :=
+sorry
+/-
+calc
+  m     = n * (m / n) : by rewrite (nat.mul_div_cancel' H1)
+    ... = n * k       : by rewrite H2
+-/
+
+protected theorem div_eq_of_eq_mul_right {m n k : ℕ} (H1 : n > 0) (H2 : m = n * k) :
+  m / n = k :=
+sorry
+/-
+calc
+  m / n = n * k / n : by rewrite -H2
+      ... = k       : by rewrite (!nat.mul_div_cancel_left H1)
+-/
+
+protected theorem eq_mul_of_div_eq_left {m n k : ℕ} (H1 : n ∣ m) (H2 : m / n = k) :
+  m = k * n :=
+mul.comm n k ▸ nat.eq_mul_of_div_eq_right H1 H2
+
+protected theorem div_eq_of_eq_mul_left {m n k : ℕ} (H1 : n > 0) (H2 : m = k * n) :
+  m / n = k :=
+nat.div_eq_of_eq_mul_right H1 (mul.comm k n ▸ H2)
+
+lemma add_mod_eq_of_dvd (i j n : nat) : n ∣ j → (i + j) % n = i % n :=
+sorry
+/-
+assume h,
+obtain k (hk : j = n * k), from exists_eq_mul_right_of_dvd h,
+begin
+  subst j, rewrite mul.comm,
+  apply add_mul_mod_self
+end
+-/
+
+/- / and ordering -/
+
+lemma le_of_dvd {m n : nat} : n > 0 → m ∣ n → m ≤ n :=
+sorry
+/-
+assume (h₁ : n > 0) (h₂ : m ∣ n),
+have h₃ : n % m = 0, from mod_eq_zero_of_dvd h₂,
+by_contradiction
+ (λ nle : ¬ m ≤ n,
+   have   h₄ : m > n, from lt_of_not_ge nle,
+   have h₅ : n % m = n, from mod_eq_of_lt h₄,
+   begin
+     rewrite h₃ at h₅, subst n,
+     exact absurd h₁ (lt.irrefl 0)
+   end)
+-/
+
+theorem div_mul_le (m n : ℕ) : m / n * n ≤ m :=
+sorry
+/-
+calc
+  m = m / n * n + m % n : by rewrite -eq_div_mul_add_mod
+    ... ≥ m / n * n     : !le_add_right
+-/
+
+protected theorem div_le_of_le_mul {m n k : ℕ} (H : m ≤ n * k) : m / k ≤ n :=
+sorry
+/-
+or.elim (eq_zero_or_pos k)
+  (assume H1 : k = 0,
+    calc
+      m / k = m / 0     : by rewrite H1
+          ... = 0       : by rewrite nat.div_zero
+          ... ≤ n       : !zero_le)
+  (assume H1 : k > 0,
+    le_of_mul_le_mul_right (calc
+      m / k * k ≤ m / k * k + m % k : !le_add_right
+        ... = m                     : by rewrite -eq_div_mul_add_mod
+        ... ≤ n * k                 : H) H1)
+-/
+
+protected theorem div_le_self (m n : ℕ) : m / n ≤ m :=
+sorry
+/-
+nat.cases_on n (!nat.div_zero⁻¹ ▸ !zero_le)
+  take n,
+  have H : m ≤ m * succ n, from calc
+        m = m * 1      : by rewrite mul_one
+      ... ≤ m * succ n : !mul_le_mul_left (succ_le_succ !zero_le),
+  nat.div_le_of_le_mul H
+-/
+
+protected theorem mul_le_of_le_div {m n k : ℕ} (H : m ≤ n / k) : m * k ≤ n :=
+calc
+  m * k ≤ n / k * k : mul_le_mul_right k H
+    ... ≤ n         : div_mul_le n k
+
+protected theorem le_div_of_mul_le {m n k : ℕ} (H1 : k > 0) (H2 : m * k ≤ n) : m ≤ n / k :=
+sorry
+/-
+have H3 : m * k < (succ (n / k)) * k, from
+  calc
+    m * k ≤ n                  : H2
+      ... = n / k * k + n % k  : by rewrite -eq_div_mul_add_mod
+      ... < n / k * k + k      : add_lt_add_left (!mod_lt H1) _
+      ... = (succ (n / k)) * k : by rewrite succ_mul,
+le_of_lt_succ (lt_of_mul_lt_mul_right H3)
+-/
+
+protected theorem le_div_iff_mul_le {m n k : ℕ} (H : k > 0) : m ≤ n / k ↔ m * k ≤ n :=
+iff.intro nat.mul_le_of_le_div (nat.le_div_of_mul_le H)
+
+protected theorem div_le_div {m n : ℕ} (k : ℕ) (H : m ≤ n) : m / k ≤ n / k :=
+sorry
+/-
+by_cases_zero_pos k
+  (by rewrite [*nat.div_zero])
+  (take k, assume H1 : k > 0, nat.le_div_of_mul_le H1 (le.trans !div_mul_le H))
+-/
+
+protected theorem div_lt_of_lt_mul {m n k : ℕ} (H : m < n * k) : m / k < n :=
+sorry
+/-
+lt_of_mul_lt_mul_right (calc
+  m / k * k ≤ m / k * k + m % k : !le_add_right
+    ... = m                     : by rewrite -eq_div_mul_add_mod
+    ... < n * k                 : H)
+-/
+
+protected theorem lt_mul_of_div_lt {m n k : ℕ} (H1 : k > 0) (H2 : m / k < n) : m < n * k :=
+sorry
+/-
+have H3 : succ (m / k) * k ≤ n * k, from !mul_le_mul_right (succ_le_of_lt H2),
+have H4 : m / k * k + k ≤ n * k, by rewrite [succ_mul at H3]; apply H3,
+calc
+  m     = m / k * k + m % k : by rewrite -eq_div_mul_add_mod
+    ... < m / k * k + k     : add_lt_add_left (!mod_lt H1) _
+    ... ≤ n * k             : H4
+-/
+
+protected theorem div_lt_iff_lt_mul {m n k : ℕ} (H : k > 0) : m / k < n ↔ m < n * k :=
+iff.intro (nat.lt_mul_of_div_lt H) nat.div_lt_of_lt_mul
+
+protected theorem div_le_iff_le_mul_of_div {m n : ℕ} (k : ℕ) (H : n > 0) (H' : n ∣ m) :
+  m / n ≤ k ↔ m ≤ k * n :=
+sorry -- by refine iff.trans (!le_iff_mul_le_mul_right H) _; rewrite [!nat.div_mul_cancel H']
+
+protected theorem le_mul_of_div_le_of_div {m n k : ℕ} (H1 : n > 0) (H2 : n ∣ m) (H3 : m / n ≤ k) :
+  m ≤ k * n :=
+iff.mp (nat.div_le_iff_le_mul_of_div k H1 H2) H3
+
+-- needed for integer division
+theorem mul_sub_div_of_lt {m n k : ℕ} (H : k < m * n) :
+  (m * n - (k + 1)) / m = n - k / m - 1 :=
+sorry
+/-
+begin
+  have H1 : k / m < n, from nat.div_lt_of_lt_mul (!mul.comm ▸ H),
+  have H2 : n - k / m ≥ 1, from
+    nat.le_sub_of_add_le (calc
+       1 + k / m = succ (k / m) : by rewrite add.comm
+               ... ≤ n          : succ_le_of_lt H1),
+  have H3 : n - k / m = n - k / m - 1 + 1, from (nat.sub_add_cancel H2)⁻¹,
+  have H4 : m > 0, from pos_of_ne_zero (assume H': m = 0, not_lt_zero k (begin rewrite [H' at H, zero_mul at H], exact H end)),
+  have H5   : k % m + 1 ≤ m, from succ_le_of_lt (!mod_lt H4),
+  have H6 : m - (k % m + 1) < m, from nat.sub_lt_self H4 !succ_pos,
+calc
+  (m * n - (k + 1)) / m = (m * n - (k / m * m + k % m + 1)) / m   : by rewrite -eq_div_mul_add_mod
+     ... = (m * n - k / m * m - (k % m + 1)) / m                  : by rewrite [*nat.sub_sub]
+     ... = ((n - k / m) * m - (k % m + 1)) / m                    :
+               by rewrite [mul.comm m, nat.mul_sub_right_distrib]
+     ... = ((n - k / m - 1) * m + m - (k % m + 1)) / m            :
+               by rewrite [H3 at {1}, right_distrib, nat.one_mul]
+     ... = ((n - k / m - 1) * m + (m - (k % m + 1))) / m          : by rewrite (nat.add_sub_assoc H5 _)
+     ... = (m - (k % m + 1)) / m + (n - k / m - 1)                :
+               by rewrite [add.comm, (add_mul_div_self H4)]
+     ... = n - k / m - 1                                          :
+               by rewrite [div_eq_zero_of_lt H6, zero_add]
+end
+-/
+
+private lemma div_div_aux (a b c : nat) : b > 0 → c > 0 → (a / b) / c = a / (b * c) :=
+sorry
+/-
+suppose b > 0, suppose c > 0,
+nat.strong_induction_on a
+(λ a ih,
+  let k₁ := a / (b*c) in
+  let k₂ := a %(b*c) in
+  have bc_pos : b*c > 0, from mul_pos `b > 0` `c > 0`,
+  have k₂ < b * c,       from mod_lt _ bc_pos,
+  have k₂ ≤ a,           from !mod_le,
+  or.elim (eq_or_lt_of_le this)
+    (suppose k₂ = a,
+     have i₁ : a < b * c,   by rewrite -this; assumption,
+     have k₁ = 0,           from div_eq_zero_of_lt i₁,
+     have a / b < c,      by rewrite [mul.comm at i₁]; exact nat.div_lt_of_lt_mul i₁,
+     begin
+       rewrite [`k₁ = 0`],
+       show (a / b) / c = 0, from div_eq_zero_of_lt `a / b < c`
+     end)
+    (suppose k₂ < a,
+     have a = k₁*(b*c) + k₂,         from eq_div_mul_add_mod a (b*c),
+     have a / b = k₁*c + k₂ / b, by
+       rewrite [this at {1}, mul.comm b c at {2}, -mul.assoc,
+                add.comm, add_mul_div_self `b > 0`, add.comm],
+     have e₁ : (a / b) / c = k₁ + (k₂ / b) / c, by
+       rewrite [this, add.comm, add_mul_div_self `c > 0`, add.comm],
+     have e₂ : (k₂ / b) / c = k₂ / (b * c), from ih k₂ `k₂ < a`,
+     have e₃ : k₂ / (b * c)   = 0,          from div_eq_zero_of_lt `k₂ < b * c`,
+     have (k₂ / b) / c      = 0,            by rewrite [e₂, e₃],
+     show (a / b) / c = k₁,                 by rewrite [e₁, this]))
+-/
+
+protected lemma div_div_eq_div_mul (a b c : nat) : (a / b) / c = a / (b * c) :=
+sorry
+/-
+begin
+ cases b with b,
+   rewrite [zero_mul, *nat.div_zero, nat.zero_div],
+   cases c with c,
+     rewrite [mul_zero, *nat.div_zero],
+     apply div_div_aux a (succ b) (succ c) dec_trivial dec_trivial
+end
+-/
+
+lemma div_lt_of_ne_zero : ∀ {n : nat}, n ≠ 0 → n / 2 < n
+:= sorry
+/-
+| 0        h := absurd rfl h
+| (succ n) h :=
+  begin
+    apply nat.div_lt_of_lt_mul,
+    rewrite [-add_one, right_distrib],
+    change n + 1 < (n * 1 + n) + (1 + 1),
+    rewrite [mul_one, -add.assoc],
+    apply add_lt_add_right,
+    show n < n + n + 1,
+    begin
+      rewrite [add.assoc, -add_zero n at {1}],
+      apply add_lt_add_left,
+      apply zero_lt_succ
+    end
+  end
+-/
+end nat
+attribute [instance, priority nat.prio] nat.nat_has_divide nat.nat_has_mod nat.dvd.decidable_rel

old_library/data/nat/examples/fib.lean

@@ -0,0 +1,61 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+-/
+import data.nat
+open nat
+
+definition fib : nat → nat
+| 0     := 1
+| 1     := 1
+| (n+2) := fib (n+1) + fib n
+
+private definition fib_fast_aux : nat → (nat × nat)
+| 0     := (0, 1)
+| 1     := (1, 1)
+| (n+2) :=
+  match (fib_fast_aux (n+1)) with
+  | (fn, fn1) := (fn1, fn1 + fn)
+  end
+
+open prod -- Get .1 .2 notation for pairs
+
+definition fib_fast (n : nat) := (fib_fast_aux n).2
+
+-- We now prove that fib_fast and fib are equal
+
+lemma fib_fast_aux_lemma : ∀ n, (fib_fast_aux (succ n)).1 = (fib_fast_aux n).2
+| 0               := rfl
+| 1               := rfl
+| (succ (succ n)) :=
+  sorry
+  /-
+  begin
+    -- TODO(Leo): fix unfold
+    -- unfold fib_fast_aux at {1}, esimp,
+    -- rewrite [-prod.eta (fib_fast_aux _)],
+    apply sorry
+  end
+  -/
+
+theorem fib_eq_fib_fast : ∀ n, fib_fast n = fib n
+| 0               := rfl
+| 1               := rfl
+| (succ (succ n)) :=
+  sorry
+  /-
+  begin
+    have feq  : fib_fast n = fib n,               from fib_eq_fib_fast n,
+    have f1eq : fib_fast (succ n) = fib (succ n), from fib_eq_fib_fast (succ n),
+    -- TODO(Leo): fix unfold
+    apply sorry
+  /-
+    unfold [fib, fib_fast, fib_fast_aux],
+    rewrite [-prod.eta (fib_fast_aux _)],
+    fold fib_fast (succ n), rewrite f1eq,
+    rewrite fib_fast_aux_lemma,
+    fold fib_fast n, rewrite feq,
+   -/
+  end
+  -/

old_library/data/nat/examples/fib2.lean

@@ -0,0 +1,46 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+
+Show that tail recursive fib is equal to standard one.
+-/
+import data.nat
+open nat
+
+definition fib : nat → nat
+| 0     := 1
+| 1     := 1
+| (n+2) := fib (n+1) + fib n
+
+private definition fib_fast_aux : nat → nat → nat → nat
+| 0     i j := j
+| (n+1) i j := fib_fast_aux n j (j+i)
+
+lemma fib_fast_aux_lemma : ∀ n m, fib_fast_aux n (fib m) (fib (succ m)) = fib (succ (n + m))
+| 0        m := sorry -- by rewrite zero_add
+| (succ n) m :=
+  sorry
+  /-
+  begin
+    have ih : fib_fast_aux n (fib (succ m)) (fib (succ (succ m))) = fib (succ (n + succ m)), from fib_fast_aux_lemma n (succ m),
+    have h₁ : fib (succ m) + fib m = fib (succ (succ m)), from rfl,
+    change fib_fast_aux n (fib (succ m)) (fib (succ m) + fib m) = fib (succ (succ n + m)),
+    rewrite [h₁, ih, succ_add, add_succ]
+  end
+  -/
+
+definition fib_fast (n: nat) :=
+fib_fast_aux n 0 1
+
+lemma fib_fast_eq_fib : ∀ n, fib_fast n = fib n
+| 0        := rfl
+| (succ n) :=
+  sorry
+  /-
+  begin
+    have h₁ : fib_fast_aux n (fib 0) (fib 1) = fib (succ n), from !fib_fast_aux_lemma,
+    change fib_fast_aux n 1 (1+0) = fib (succ n),
+    krewrite h₁
+  end
+  -/

old_library/data/nat/examples/partial_sum.lean

@@ -0,0 +1,40 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Leonardo de Moura
+-/
+import data.nat
+open nat
+
+definition partial_sum : nat → nat
+| 0        := 0
+| (succ n) := succ n + partial_sum n
+
+example : partial_sum 5 = 15 :=
+rfl
+
+example : partial_sum 6 = 21 :=
+rfl
+
+lemma two_mul_partial_sum_eq : ∀ n, 2 * partial_sum n = (succ n) * n
+| 0        := sorry -- by reflexivity
+| (succ n) :=
+sorry
+/-
+calc
+   2 * (succ n + partial_sum n) = 2 * succ n + 2 * partial_sum n  : by rewrite left_distrib
+                   ...   = 2 * succ n + succ n * n  : by rewrite two_mul_partial_sum_eq
+                   ...   = 2 * succ n + n * succ n  : by rewrite (mul.comm n (succ n))
+                   ...   = (2 + n) * succ n         : by rewrite right_distrib
+                   ...   = (n + 2) * succ n         : by rewrite add.comm
+                   ...   = (succ (succ n)) * succ n : rfl
+-/
+
+theorem partial_sum_eq : ∀ n, partial_sum n = ((n + 1) * n) / 2 :=
+sorry
+/-
+take n,
+have h₁ : (2 * partial_sum n) / 2 = ((succ n) * n) / 2, by rewrite two_mul_partial_sum_eq,
+have h₂ : (2:nat) > 0, from dec_trivial,
+by rewrite [nat.mul_div_cancel_left _ h₂ at h₁]; exact h₁
+-/

old_library/data/nat/fact.lean

@@ -0,0 +1,61 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+
+Factorial
+-/
+import data.nat.div
+
+namespace nat
+definition fact : nat → nat
+| 0        := 1
+| (succ n) := (succ n) * fact n
+
+lemma fact_zero : fact 0 = 1 :=
+rfl
+
+lemma fact_one : fact 1 = 1 :=
+rfl
+
+lemma fact_succ (n) : fact (succ n) = succ n * fact n :=
+rfl
+
+lemma fact_pos : ∀ n, fact n > 0
+| 0        := zero_lt_one
+| (succ n) := mul_pos (succ_pos n) (fact_pos n)
+
+lemma fact_ne_zero (n : ℕ) : fact n ≠ 0 := ne_of_gt (fact_pos n)
+
+lemma dvd_fact : ∀ {m n}, m > 0 → m ≤ n → m ∣ fact n
+| m 0        h₁ h₂ := absurd h₁ (not_lt_of_ge h₂)
+| m (succ n) h₁ h₂ :=
+  sorry
+/-
+  begin
+    rewrite fact_succ,
+    cases (eq_or_lt_of_le h₂) with he hl,
+      {subst m, apply dvd_mul_right},
+      {have aux : m ∣ fact n, from dvd_fact h₁ (le_of_lt_succ hl),
+       apply dvd_mul_of_dvd_right aux}
+  end
+-/
+
+lemma fact_le {m n} : m ≤ n → fact m ≤ fact n :=
+sorry
+/-
+begin
+  induction n with n ih,
+   {intro h,
+    have meq0 : m = 0, from eq_zero_of_le_zero h,
+    subst m},
+   {intro m_le_succ_n,
+    cases (eq_or_lt_of_le m_le_succ_n) with h₁ h₂,
+      {subst m},
+      {transitivity (fact n),
+        exact ih (le_of_lt_succ h₂),
+        rewrite [fact_succ, -one_mul at {1}],
+        exact nat.mul_le_mul (succ_le_succ (zero_le n)) !le.refl}}
+end
+-/
+end nat

old_library/data/nat/find.lean

@@ -0,0 +1,123 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+
+Choice function for decidable predicates on natural numbers.
+
+This module provides the following two declarations:
+
+choose      {p : nat → Prop} [d : decidable_pred p] : (∃ x, p x) → nat
+choose_spec {p : nat → Prop} [d : decidable_pred p] (ex : ∃ x, p x) : p (choose ex)
+-/
+import data.nat.basic data.nat.order
+open nat subtype decidable well_founded
+
+namespace nat
+section find_x
+parameter {p : nat → Prop}
+
+private definition lbp (x : nat) : Prop := ∀ y, y < x → ¬ p y
+
+private lemma lbp_zero : lbp 0 :=
+λ y h, absurd h (not_lt_zero y)
+
+private lemma lbp_succ {x : nat} : lbp x → ¬ p x → lbp (succ x) :=
+sorry
+/-
+λ lx npx y yltsx,
+  or.elim (eq_or_lt_of_le (le_of_succ_le_succ yltsx))
+    (suppose y = x, by substvars; assumption)
+    (suppose y < x, lx y this)
+-/
+
+private definition gtb (a b : nat) : Prop :=
+a > b ∧ lbp a
+
+local infix ` ≺ `:50 := gtb
+
+private lemma acc_of_px {x : nat} : p x → acc gtb x :=
+sorry
+/-
+assume h,
+acc.intro x (λ (y : nat) (l : y ≺ x),
+  obtain (h₁ : y > x) (h₂ : ∀ a, a < y → ¬ p a), from l,
+  absurd h (h₂ x h₁))
+-/
+
+private lemma acc_of_acc_succ {x : nat} : acc gtb (succ x) → acc gtb x :=
+sorry
+/-
+assume h,
+acc.intro x (λ (y : nat) (l : y ≺ x),
+   by_cases
+     (suppose y = succ x, by substvars; assumption)
+     (suppose y ≠ succ x,
+        have x < y,      from and.elim_left l,
+        have succ x < y, from lt_of_le_of_ne this (ne.symm `y ≠ succ x`),
+        acc.inv h (and.intro this (and.elim_right l))))
+-/
+
+private lemma acc_of_px_of_gt {x y : nat} : p x → y > x → acc gtb y :=
+sorry
+/-
+assume px ygtx,
+acc.intro y (λ (z : nat) (l : z ≺ y),
+  obtain (zgty : z > y) (h : ∀ a, a < z → ¬ p a), from l,
+  absurd px (h x (lt.trans ygtx zgty)))
+-/
+
+private lemma acc_of_acc_of_lt : ∀ {x y : nat}, acc gtb x → y < x → acc gtb y
+:= sorry
+/-
+| 0        y a0  ylt0  := absurd ylt0 !not_lt_zero
+| (succ x) y asx yltsx :=
+  have acc gtb x, from acc_of_acc_succ asx,
+  by_cases
+     (suppose y = x, by substvars; assumption)
+     (suppose y ≠ x, acc_of_acc_of_lt `acc gtb x` (lt_of_le_of_ne (le_of_lt_succ yltsx) this))
+-/
+
+parameter (ex : ∃ a, p a)
+parameter [dp : decidable_pred p]
+include dp
+
+private lemma acc_of_ex (x : nat) : acc gtb x :=
+sorry
+/-
+using ex,
+obtain (w : nat) (pw : p w), from ex,
+lt.by_cases
+  (suppose x < w, acc_of_acc_of_lt (acc_of_px pw) this)
+  (suppose x = w, by subst x; exact (acc_of_px pw))
+  (suppose x > w, acc_of_px_of_gt pw this)
+-/
+private lemma wf_gtb : well_founded gtb :=
+well_founded.intro acc_of_ex
+
+private definition find.F (x : nat) : (Π x₁, x₁ ≺ x → lbp x₁ → {a : nat \ p a}) → lbp x → {a : nat \ p a} :=
+match x with
+| 0 := λ f l0, by_cases
+  (λ p0 : p 0,    tag 0 p0)
+  (suppose ¬ p 0,
+    have h₁ : lbp 1, from lbp_succ l0 this,
+    have 1 ≺ 0, from and.intro (lt.base 0) h₁,
+    f 1 this h₁)
+| (succ n) := λ f lsn, by_cases
+  (suppose p (succ n), tag (succ n) this)
+  (suppose ¬ p (succ n),
+    have lss : lbp (succ (succ n)), from lbp_succ lsn this,
+    have succ (succ n) ≺ succ n, from and.intro (lt.base (succ n)) lss,
+    f (succ (succ n)) this lss)
+end
+include ex -- todo remove
+private definition find_x : {x : nat \ p x} :=
+@fix _ _ _ wf_gtb find.F 0 lbp_zero
+end find_x
+
+protected definition find {p : nat → Prop} [d : decidable_pred p] : (∃ x, p x) → nat :=
+assume h, elt_of (find_x h)
+
+protected theorem find_spec {p : nat → Prop} [d : decidable_pred p] (ex : ∃ x, p x) : p (nat.find ex) :=
+has_property (find_x ex)
+end nat

old_library/data/nat/gcd.lean

@@ -0,0 +1,412 @@
+/-
+Copyright (c) 2014 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad, Leonardo de Moura
+
+Definitions and properties of gcd, lcm, and coprime.
+-/
+import .div
+open well_founded decidable prod
+
+namespace nat
+
+/- gcd -/
+
+private definition pair_nat.lt : nat × nat → nat × nat → Prop := measure pr₂
+private definition pair_nat.lt.wf : well_founded pair_nat.lt :=
+intro_k (measure_wf pr₂) 20  -- we use intro_k to be able to execute gcd efficiently in the kernel
+
+local infixl ` ≺ `:50 := pair_nat.lt
+
+private definition gcd.lt.dec (x y₁ : nat) : (succ y₁, x % succ y₁) ≺ (x, succ y₁) :=
+mod_lt x (succ_pos y₁)
+
+definition gcd.F : Π (p₁ : nat × nat), (Π p₂ : nat × nat, p₂ ≺ p₁ → nat) → nat
+| (x, 0)      f := x
+| (x, succ y) f := f (succ y, x % succ y) (gcd.lt.dec x y)
+
+definition gcd (x y : nat) := fix pair_nat.lt.wf gcd.F (x, y)
+
+attribute [simp]
+theorem gcd_zero_right (x : nat) : gcd x 0 = x := rfl
+
+attribute [simp]
+theorem gcd_succ (x y : nat) : gcd x (succ y) = gcd (succ y) (x % succ y) :=
+well_founded.fix_eq pair_nat.lt.wf gcd.F (x, succ y)
+
+theorem gcd_one_right (n : ℕ) : gcd n 1 = 1 :=
+calc gcd n 1 = gcd 1 (n % 1)  : gcd_succ n 0
+         ... = gcd 1 0        : sorry -- by rewrite mod_one
+
+theorem gcd_def (x : ℕ) : Π (y : ℕ), gcd x y = if y = 0 then x else gcd y (x % y)
+| 0        := gcd_zero_right _
+| (succ y) := eq.trans (gcd_succ x y) $ eq.symm (if_neg (succ_ne_zero y))
+
+
+theorem gcd_self : Π (n : ℕ), gcd n n = n
+| 0         := rfl
+| (succ n₁) := calc
+    gcd (succ n₁) (succ n₁) = gcd (succ n₁) (succ n₁ % succ n₁) : gcd_succ (succ n₁) n₁
+                      ...   = gcd (succ n₁) 0                   : sorry -- by rewrite mod_self
+
+theorem gcd_zero_left : Π (n : ℕ), gcd 0 n = n
+| 0         := rfl
+| (succ n₁) := calc
+    gcd 0 (succ n₁) = gcd (succ n₁) (0 % succ n₁)   : gcd_succ 0 n₁
+                ... = gcd (succ n₁) 0               : sorry -- by rewrite zero_mod
+
+theorem gcd_of_pos (m : ℕ) {n : ℕ} (H : n > 0) : gcd m n = gcd n (m % n) :=
+eq.trans (gcd_def m n) $ if_neg (ne_zero_of_pos H)
+
+theorem gcd_rec (m n : ℕ) : gcd m n = gcd n (m % n) :=
+sorry
+/-
+by_cases_zero_pos n
+  (calc
+          m = gcd 0 m       : by rewrite gcd_zero_left
+        ... = gcd 0 (m % 0) : by rewrite mod_zero)
+  (take n, assume H : 0 < n, gcd_of_pos m H)
+-/
+
+theorem gcd.induction {P : ℕ → ℕ → Prop}
+                   (m n : ℕ)
+                   (H0 : ∀m, P m 0)
+                   (H1 : ∀m n, 0 < n → P n (m % n) → P m n) :
+                 P m n :=
+induction pair_nat.lt.wf (m, n) (prod.rec (λm, nat.rec (λ IH, H0 m)
+   (λ n₁ v (IH : ∀p₂, p₂ ≺ (m, succ n₁) → P (pr₁ p₂) (pr₂ p₂)),
+      H1 m (succ n₁) (succ_pos n₁) (IH _ (gcd.lt.dec m n₁)))))
+
+theorem gcd_dvd (m n : ℕ) : (gcd m n ∣ m) ∧ (gcd m n ∣ n) :=
+gcd.induction m n
+  (take m, and.intro (one_mul m ▸ dvd_mul_left m 1) (dvd_zero (gcd m 0)))
+  (take m n (npos : 0 < n), and.rec
+     (assume (IH₁ : gcd n (m % n) ∣ n) (IH₂ : gcd n (m % n) ∣ (m % n)),
+    have H : (gcd n (m % n) ∣ (m / n * n + m % n)), from
+      dvd_add (dvd.trans IH₁ (dvd_mul_left n (m / n))) IH₂,
+    have H1 : (gcd n (m % n) ∣ m), from eq.symm (eq_div_mul_add_mod m n) ▸ H,
+    show (gcd m n ∣ m) ∧ (gcd m n ∣ n), from eq.symm (gcd_rec m n) ▸ (and.intro H1 IH₁)))
+
+theorem gcd_dvd_left (m n : ℕ) : gcd m n ∣ m := and.left $ gcd_dvd m n
+
+theorem gcd_dvd_right (m n : ℕ) : gcd m n ∣ n := and.right $ gcd_dvd m n
+
+theorem dvd_gcd {m n k : ℕ} : k ∣ m → k ∣ n → k ∣ gcd m n :=
+gcd.induction m n (take m, imp.intro)
+  (take m n (npos : n > 0)
+    (IH : k ∣ n → k ∣ m % n → k ∣ gcd n (m % n))
+    (H1 : k ∣ m) (H2 : k ∣ n),
+    have H3 : k ∣ m / n * n + m % n, from eq_div_mul_add_mod m n ▸ H1,
+    have H4 : k ∣ m % n, from nat.dvd_of_dvd_add_left H3 (dvd.trans H2 (dvd_mul_left n (m / n))),
+    eq.symm (gcd_rec m n) ▸ IH H2 H4)
+
+theorem gcd.comm (m n : ℕ) : gcd m n = gcd n m :=
+dvd.antisymm
+  (dvd_gcd (gcd_dvd_right m n) (gcd_dvd_left m n))
+  (dvd_gcd (gcd_dvd_right n m) (gcd_dvd_left n m))
+
+theorem gcd.assoc (m n k : ℕ) : gcd (gcd m n) k = gcd m (gcd n k) :=
+dvd.antisymm
+  (dvd_gcd
+    (dvd.trans (gcd_dvd_left (gcd m n) k) (gcd_dvd_left m n))
+    (dvd_gcd (dvd.trans (gcd_dvd_left (gcd m n) k) (gcd_dvd_right m n)) (gcd_dvd_right (gcd m n) k)))
+  (dvd_gcd
+    (dvd_gcd (gcd_dvd_left m (gcd n k)) (dvd.trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_left n k)))
+    (dvd.trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_right n k)))
+
+theorem gcd_one_left (m : ℕ) : gcd 1 m = 1 :=
+eq.trans (gcd.comm 1 m) $ gcd_one_right m
+
+theorem gcd_mul_left (m n k : ℕ) : gcd (m * n) (m * k) = m * gcd n k :=
+sorry
+/-
+gcd.induction n k
+  (take n, calc gcd (m * n) (m * 0) = gcd (m * n) 0 : by rewrite mul_zero)
+  (take n k,
+    assume H : 0 < k,
+    assume IH : gcd (m * k) (m * (n % k)) = m * gcd k (n % k),
+    calc
+      gcd (m * n) (m * k) = gcd (m * k) (m * n % (m * k)) : !gcd_rec
+                      ... = gcd (m * k) (m * (n % k))     : by rewrite mul_mod_mul_left
+                      ... = m * gcd k (n % k)             : by rewrite IH
+                      ... = m * gcd n k                   : by rewrite -gcd_rec)
+-/
+
+theorem gcd_mul_right (m n k : ℕ) : gcd (m * n) (k * n) = gcd m k * n :=
+sorry
+/-
+calc
+  gcd (m * n) (k * n) = gcd (n * m) (k * n) : by rewrite (mul.comm m n)
+                  ... = gcd (n * m) (n * k) : by rewrite (mul.comm n k)
+                  ... = n * gcd m k         : by rewrite gcd_mul_left
+                  ... = gcd m k * n         : by rewrite mul.comm
+-/
+
+theorem gcd_pos_of_pos_left {m : ℕ} (n : ℕ) (mpos : m > 0) : gcd m n > 0 :=
+pos_of_dvd_of_pos (gcd_dvd_left m n) mpos
+
+theorem gcd_pos_of_pos_right (m : ℕ) {n : ℕ} (npos : n > 0) : gcd m n > 0 :=
+pos_of_dvd_of_pos (gcd_dvd_right m n) npos
+
+theorem eq_zero_of_gcd_eq_zero_left {m n : ℕ} (H : gcd m n = 0) : m = 0 :=
+or.elim (eq_zero_or_pos m)
+  (assume H1, H1)
+  (assume H1 : m > 0, absurd (eq.symm H) (ne_of_lt (gcd_pos_of_pos_left _ H1)))
+
+theorem eq_zero_of_gcd_eq_zero_right {m n : ℕ} (H : gcd m n = 0) : n = 0 :=
+eq_zero_of_gcd_eq_zero_left (gcd.comm m n ▸ H)
+
+theorem gcd_div {m n k : ℕ} (H1 : k ∣ m) (H2 : k ∣ n) :
+  gcd (m / k) (n / k) = gcd m n / k :=
+sorry
+/-
+or.elim (eq_zero_or_pos k)
+  (assume H3 : k = 0, by subst k; rewrite *nat.div_zero)
+  (assume H3 : k > 0, (nat.div_eq_of_eq_mul_left H3 (calc
+        gcd m n = gcd m (n / k * k)             : by rewrite (nat.div_mul_cancel H2)
+            ... = gcd (m / k * k) (n / k * k) : by rewrite (nat.div_mul_cancel H1)
+            ... = gcd (m / k) (n / k) * k     : by rewrite gcd_mul_right))⁻¹)
+-/
+
+theorem gcd_dvd_gcd_mul_left (m n k : ℕ) : gcd m n ∣ gcd (k * m) n :=
+dvd_gcd (dvd.trans (gcd_dvd_left m n) (dvd_mul_left m k)) (gcd_dvd_right m n)
+
+theorem gcd_dvd_gcd_mul_right (m n k : ℕ) : gcd m n ∣ gcd (m * k) n :=
+mul.comm k m ▸ gcd_dvd_gcd_mul_left m n k
+
+theorem gcd_dvd_gcd_mul_left_right (m n k : ℕ) : gcd m n ∣ gcd m (k * n) :=
+dvd_gcd (gcd_dvd_left m n) (dvd.trans (gcd_dvd_right m n) (dvd_mul_left n k))
+
+theorem gcd_dvd_gcd_mul_right_right (m n k : ℕ) : gcd m n ∣ gcd m (n * k) :=
+mul.comm k n ▸ gcd_dvd_gcd_mul_left_right m n k
+
+/- lcm -/
+
+definition lcm (m n : ℕ) : ℕ := m * n / (gcd m n)
+
+theorem lcm.comm (m n : ℕ) : lcm m n = lcm n m :=
+sorry
+/-
+calc
+  lcm m n = m * n / gcd m n : rfl
+      ... = n * m / gcd m n : by rewrite mul.comm
+      ... = n * m / gcd n m : by rewrite gcd.comm
+      ... = lcm n m           : rfl
+-/
+
+theorem lcm_zero_left (m : ℕ) : lcm 0 m = 0 :=
+sorry
+/-
+calc
+  lcm 0 m = 0 * m / gcd 0 m : rfl
+      ... = 0 / gcd 0 m     : by rewrite zero_mul
+      ... = 0               : by rewrite nat.zero_div
+-/
+
+theorem lcm_zero_right (m : ℕ) : lcm m 0 = 0 := lcm.comm 0 m ▸ lcm_zero_left m
+
+theorem lcm_one_left (m : ℕ) : lcm 1 m = m :=
+sorry
+/-
+calc
+  lcm 1 m = 1 * m / gcd 1 m : rfl
+      ... = m / gcd 1 m     : by rewrite one_mul
+      ... = m / 1           : by rewrite gcd_one_left
+      ... = m                 : by rewrite nat.div_one
+-/
+
+theorem lcm_one_right (m : ℕ) : lcm m 1 = m := lcm.comm 1 m ▸ lcm_one_left m
+
+theorem lcm_self (m : ℕ) : lcm m m = m :=
+sorry
+/-
+have H : m * m / m = m, from
+  by_cases_zero_pos m !nat.div_zero (take m, assume H1 : m > 0, !nat.mul_div_cancel H1),
+calc
+  lcm m m = m * m / gcd m m : rfl
+      ... = m * m / m       : by rewrite gcd_self
+      ... = m               : H
+-/
+
+theorem dvd_lcm_left (m n : ℕ) : m ∣ lcm m n :=
+have H : lcm m n = m * (n / gcd m n), from nat.mul_div_assoc _ $ gcd_dvd_right m n,
+dvd.intro (eq.symm H)
+
+theorem dvd_lcm_right (m n : ℕ) : n ∣ lcm m n :=
+lcm.comm n m ▸ dvd_lcm_left n m
+
+theorem gcd_mul_lcm (m n : ℕ) : gcd m n * lcm m n = m * n :=
+eq.symm (nat.eq_mul_of_div_eq_right (dvd.trans (gcd_dvd_left m n) (dvd_mul_right m n)) rfl)
+
+theorem lcm_dvd {m n k : ℕ} (H1 : m ∣ k) (H2 : n ∣ k) : lcm m n ∣ k :=
+sorry
+/-
+or.elim (eq_zero_or_pos k)
+  (assume kzero : k = 0, !kzero⁻¹ ▸ !dvd_zero)
+  (assume kpos : k > 0,
+    have mpos : m > 0, from pos_of_dvd_of_pos H1 kpos,
+    have npos : n > 0, from pos_of_dvd_of_pos H2 kpos,
+    have gcd_pos : gcd m n > 0, from !gcd_pos_of_pos_left mpos,
+    obtain p (km : k = m * p), from exists_eq_mul_right_of_dvd H1,
+    obtain q (kn : k = n * q), from exists_eq_mul_right_of_dvd H2,
+    have ppos : p > 0, from pos_of_mul_pos_left (km ▸ kpos),
+    have qpos : q > 0, from pos_of_mul_pos_left (kn ▸ kpos),
+    have H3 : p * q * (m * n * gcd p q) = p * q * (gcd m n * k), from
+    calc
+      p * q * (m * n * gcd p q)
+            = m * p * (n * q * gcd p q)       : by rewrite [*mul.assoc, *mul.left_comm q,
+                                                             mul.left_comm p]
+        ... = k * (k * gcd p q)               : by rewrite [-kn, -km]
+        ... = k * gcd (k * p) (k * q)         : by rewrite gcd_mul_left
+        ... = k * gcd (n * q * p) (m * p * q) : by rewrite [-kn, -km]
+        ... = k * (gcd n m * (p * q))         : by rewrite [*mul.assoc, mul.comm q, gcd_mul_right]
+        ... = p * q * (gcd m n * k)           : by rewrite [mul.comm, mul.comm (gcd n m), gcd.comm,
+                                                             *mul.assoc],
+    have H4 : m * n * gcd p q = gcd m n * k,
+      from !eq_of_mul_eq_mul_left (mul_pos ppos qpos) H3,
+    have H5 : gcd m n * (lcm m n * gcd p q) = gcd m n * k,
+      from !mul.assoc ▸ !gcd_mul_lcm⁻¹ ▸ H4,
+    have H6 : lcm m n * gcd p q = k,
+      from !eq_of_mul_eq_mul_left gcd_pos H5,
+    dvd.intro H6)
+-/
+
+theorem lcm.assoc (m n k : ℕ) : lcm (lcm m n) k = lcm m (lcm n k) :=
+dvd.antisymm
+  (lcm_dvd
+    (lcm_dvd (dvd_lcm_left m (lcm n k)) (dvd.trans (dvd_lcm_left n k) (dvd_lcm_right m (lcm n k))))
+    (dvd.trans (dvd_lcm_right n k) (dvd_lcm_right m (lcm n k))))
+  (lcm_dvd
+    (dvd.trans (dvd_lcm_left m n) (dvd_lcm_left (lcm m n) k))
+    (lcm_dvd (dvd.trans (dvd_lcm_right m n) (dvd_lcm_left (lcm m n) k)) (dvd_lcm_right (lcm m n) k)))
+
+/- coprime -/
+
+attribute [reducible]
+definition coprime (m n : ℕ) : Prop := gcd m n = 1
+
+lemma gcd_eq_one_of_coprime {m n : ℕ} : coprime m n → gcd m n = 1 :=
+λ h, h
+
+theorem coprime_swap {m n : ℕ} (H : coprime n m) : coprime m n :=
+gcd.comm n m ▸ H
+
+theorem dvd_of_coprime_of_dvd_mul_right {m n k : ℕ} (H1 : coprime k n) (H2 : k ∣ m * n) : k ∣ m :=
+sorry
+/-
+have H3 : gcd (m * k) (m * n) = m, from
+  calc
+    gcd (m * k) (m * n) = m * gcd k n : by rewrite gcd_mul_left
+                    ... = m * 1       : begin unfold coprime at H1, rewrite H1 end
+                    ... = m           : by rewrite mul_one,
+have H4 : (k ∣ gcd (m * k) (m * n)), from dvd_gcd !dvd_mul_left H2,
+H3 ▸ H4
+-/
+
+theorem dvd_of_coprime_of_dvd_mul_left {m n k : ℕ} (H1 : coprime k m) (H2 : k ∣ m * n) : k ∣ n :=
+dvd_of_coprime_of_dvd_mul_right H1 (mul.comm m n ▸ H2)
+
+theorem gcd_mul_left_cancel_of_coprime {k : ℕ} (m : ℕ) {n : ℕ} (H : coprime k n) :
+   gcd (k * m) n = gcd m n :=
+sorry
+/-
+have H1 : coprime (gcd (k * m) n) k, from
+  calc
+    gcd (gcd (k * m) n) k
+         = gcd (k * gcd 1 m) n : by rewrite [-gcd_mul_left, mul_one, gcd.comm, gcd.assoc]
+     ... = 1                   : by rewrite [gcd_one_left, mul_one, ↑coprime at H, H],
+dvd.antisymm
+  (dvd_gcd (dvd_of_coprime_of_dvd_mul_left H1 !gcd_dvd_left) !gcd_dvd_right)
+  (dvd_gcd (dvd.trans !gcd_dvd_left !dvd_mul_left) !gcd_dvd_right)
+-/
+
+theorem gcd_mul_right_cancel_of_coprime (m : ℕ) {k n : ℕ} (H : coprime k n) :
+   gcd (m * k) n = gcd m n :=
+mul.comm k m ▸ gcd_mul_left_cancel_of_coprime m H
+
+theorem gcd_mul_left_cancel_of_coprime_right {k m : ℕ} (n : ℕ) (H : coprime k m) :
+   gcd m (k * n) = gcd m n :=
+gcd.comm n m ▸ gcd.comm (k * n) m ▸ gcd_mul_left_cancel_of_coprime n H
+
+theorem gcd_mul_right_cancel_of_coprime_right {k m : ℕ} (n : ℕ) (H : coprime k m) :
+   gcd m (n * k) = gcd m n :=
+gcd.comm n m ▸ gcd.comm (n * k) m ▸ gcd_mul_right_cancel_of_coprime n H
+
+theorem coprime_div_gcd_div_gcd {m n : ℕ} (H : gcd m n > 0) :
+  coprime (m / gcd m n) (n / gcd m n) :=
+calc
+  gcd (m / gcd m n) (n / gcd m n) = gcd m n / gcd m n : gcd_div (gcd_dvd_left m n) (gcd_dvd_right m n)
+     ... = 1 : nat.div_self H
+
+theorem not_coprime_of_dvd_of_dvd {m n d : ℕ} (dgt1 : d > 1) (Hm : d ∣ m) (Hn : d ∣ n) :
+  ¬ coprime m n :=
+sorry
+/-
+assume co : coprime m n,
+have d ∣ gcd m n, from dvd_gcd Hm Hn,
+have d ∣ 1, by rewrite [↑coprime at co, co at this]; apply this,
+have d ≤ 1, from le_of_dvd dec_trivial this,
+show false, from not_lt_of_ge `d ≤ 1` `d > 1`
+-/
+
+theorem exists_coprime {m n : ℕ} (H : gcd m n > 0) :
+  exists m' n', coprime m' n' ∧ m = m' * gcd m n ∧ n = n' * gcd m n :=
+have H1 : m = (m / gcd m n) * gcd m n, from eq.symm (nat.div_mul_cancel (gcd_dvd_left m n)),
+have H2 : n = (n / gcd m n) * gcd m n, from eq.symm (nat.div_mul_cancel (gcd_dvd_right m n)),
+exists.intro _ (exists.intro _ (and.intro (coprime_div_gcd_div_gcd H) (and.intro H1 H2)))
+
+theorem coprime_mul {m n k : ℕ} (H1 : coprime m k) (H2 : coprime n k) : coprime (m * n) k :=
+calc
+  gcd (m * n) k = gcd n k : gcd_mul_left_cancel_of_coprime n H1
+            ... = 1       : H2
+
+theorem coprime_mul_right {k m n : ℕ} (H1 : coprime k m) (H2 : coprime k n) : coprime k (m * n) :=
+coprime_swap (coprime_mul (coprime_swap H1) (coprime_swap H2))
+
+theorem coprime_of_coprime_mul_left {k m n : ℕ} (H : coprime (k * m) n) : coprime m n :=
+have H1 : (gcd m n ∣ gcd (k * m) n), from gcd_dvd_gcd_mul_left m n k,
+eq_one_of_dvd_one (H ▸ H1)
+
+theorem coprime_of_coprime_mul_right {k m n : ℕ} (H : coprime (m * k) n) : coprime m n :=
+coprime_of_coprime_mul_left (mul.comm m k ▸ H)
+
+theorem coprime_of_coprime_mul_left_right {k m n : ℕ} (H : coprime m (k * n)) : coprime m n :=
+coprime_swap (coprime_of_coprime_mul_left (coprime_swap H))
+
+theorem coprime_of_coprime_mul_right_right {k m n : ℕ} (H : coprime m (n * k)) : coprime m n :=
+coprime_of_coprime_mul_left_right (mul.comm n k ▸ H)
+
+theorem comprime_one_left : ∀ n, coprime 1 n :=
+λ n, gcd_one_left n
+
+theorem comprime_one_right : ∀ n, coprime n 1 :=
+λ n, gcd_one_right n
+
+theorem exists_eq_prod_and_dvd_and_dvd {m n k : nat} (H : k ∣ m * n) :
+  ∃ m' n', k = m' * n' ∧ m' ∣ m ∧ n' ∣ n :=
+sorry
+/-
+or.elim (eq_zero_or_pos (gcd k m))
+ (assume H1 : gcd k m = 0,
+    have H2 : k = 0, from eq_zero_of_gcd_eq_zero_left H1,
+    have H3 : m = 0, from eq_zero_of_gcd_eq_zero_right H1,
+    have H4 : k = 0 * n, from H2 ⬝ !zero_mul⁻¹,
+    have H5 : 0 ∣ m, from H3⁻¹ ▸ !dvd.refl,
+    have H6 : n ∣ n, from !dvd.refl,
+    exists.intro _ (exists.intro _ (and.intro H4 (and.intro H5 H6))))
+  (assume H1 : gcd k m > 0,
+    have H2 : gcd k m ∣ k, from !gcd_dvd_left,
+    have H3 : k / gcd k m ∣ (m * n) / gcd k m, from nat.div_dvd_div H2 H,
+    have H4 : (m * n) / gcd k m = (m / gcd k m) * n, from
+      calc
+        m * n / gcd k m = n * m / gcd k m   : by rewrite mul.comm
+                      ... = n * (m / gcd k m) : !nat.mul_div_assoc !gcd_dvd_right
+                      ... = m / gcd k m * n   : by rewrite mul.comm,
+    have H5 : k / gcd k m ∣ (m / gcd k m) * n, from H4 ▸ H3,
+    have H6 : coprime (k / gcd k m) (m / gcd k m), from coprime_div_gcd_div_gcd H1,
+    have H7 : k / gcd k m ∣ n, from dvd_of_coprime_of_dvd_mul_left H6 H5,
+    have H8 : k = gcd k m * (k / gcd k m), from (nat.mul_div_cancel' H2)⁻¹,
+    exists.intro _ (exists.intro _ (and.intro H8 (and.intro !gcd_dvd_right H7))))
+-/
+
+end nat

old_library/data/nat/nat.md

@@ -0,0 +1,14 @@
+data.nat
+========
+
+The natural numbers.
+
+* [basic](basic.lean) : the natural numbers, with succ, pred, addition, and multiplication
+* [order](order.lean) : less-than, less-then-or-equal, etc.
+* [bquant](bquant.lean) : bounded quantifiers
+* [sub](sub.lean) : subtraction, and distance
+* [div](div.lean) : div and mod
+* [gcd](gcd.lean) : gcd, lcm, and coprime
+* [power](power.lean)
+* [bigops](bigops.lean) : finite sums and products
+* [find](find.lean) : search for a witness to an existence statement

old_library/data/nat/order.lean

@@ -0,0 +1,616 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad
+
+The order relation on the natural numbers.
+-/
+import .basic algebra.ordered_ring
+
+namespace nat
+
+/- lt and le -/
+
+protected theorem le_of_lt_or_eq {m n : ℕ} (H : m < n ∨ m = n) : m ≤ n :=
+nat.le_of_eq_or_lt (or.swap H)
+
+protected theorem lt_or_eq_of_le {m n : ℕ} (H : m ≤ n) : m < n ∨ m = n :=
+or.swap (nat.eq_or_lt_of_le H)
+
+protected theorem le_iff_lt_or_eq (m n : ℕ) : m ≤ n ↔ m < n ∨ m = n :=
+iff.intro nat.lt_or_eq_of_le nat.le_of_lt_or_eq
+
+protected theorem lt_of_le_and_ne {m n : ℕ} (H1 : m ≤ n) : m ≠ n → m < n :=
+or_resolve_right (nat.eq_or_lt_of_le H1)
+
+protected theorem lt_iff_le_and_ne (m n : ℕ) : m < n ↔ m ≤ n ∧ m ≠ n :=
+iff.intro
+  (take H, and.intro (nat.le_of_lt H) (take H1, nat.lt_irrefl n (H1 ▸ H)))
+  (and.rec nat.lt_of_le_and_ne)
+
+theorem le_add_right (n k : ℕ) : n ≤ n + k :=
+nat.rec (nat.le_refl n) (λ k, le_succ_of_le) k
+
+theorem le_add_left (n m : ℕ): n ≤ m + n :=
+add.comm n m ▸ le_add_right n m
+
+theorem le.intro {n m k : ℕ} (h : n + k = m) : n ≤ m :=
+h ▸ le_add_right n k
+
+theorem le.elim {n m : ℕ} : n ≤ m → ∃ k, n + k = m :=
+le.rec (exists.intro 0 rfl) (λm h, Exists.rec
+  (λ k H, exists.intro (succ k) (H ▸ rfl)))
+
+protected theorem le_total {m n : ℕ} : m ≤ n ∨ n ≤ m :=
+or.imp_left nat.le_of_lt (nat.lt_or_ge m n)
+
+/- addition -/
+
+protected theorem add_le_add_left {n m : ℕ} (H : n ≤ m) (k : ℕ) : k + n ≤ k + m :=
+sorry -- obtain l Hl, from le.elim H, le.intro (Hl ▸ !add.assoc)
+
+protected theorem add_le_add_right {n m : ℕ} (H : n ≤ m) (k : ℕ) : n + k ≤ m + k :=
+add.comm k m ▸ add.comm k n ▸ nat.add_le_add_left H k
+
+protected theorem le_of_add_le_add_left {k n m : ℕ} (H : k + n ≤ k + m) : n ≤ m :=
+sorry -- obtain l Hl, from le.elim H, le.intro (nat.add_left_cancel (!add.assoc⁻¹ ⬝ Hl))
+
+protected theorem lt_of_add_lt_add_left {k n m : ℕ} (H : k + n < k + m) : n < m :=
+let H' := nat.le_of_lt H in
+nat.lt_of_le_and_ne (nat.le_of_add_le_add_left H') (assume Heq, nat.lt_irrefl (k + m) (Heq ▸ H))
+
+protected theorem add_lt_add_left {n m : ℕ} (H : n < m) (k : ℕ) : k + n < k + m :=
+lt_of_succ_le (add_succ k n ▸ nat.add_le_add_left (succ_le_of_lt H) k)
+
+protected theorem add_lt_add_right {n m : ℕ} (H : n < m) (k : ℕ) : n + k < m + k :=
+add.comm k m ▸ add.comm k n ▸ nat.add_lt_add_left H k
+
+protected theorem lt_add_of_pos_right {n k : ℕ} (H : k > 0) : n < n + k :=
+add_zero (n + k) ▸ nat.add_lt_add_left H n
+
+/- multiplication -/
+
+theorem mul_le_mul_left {n m : ℕ} (k : ℕ) (H : n ≤ m) : k * n ≤ k * m :=
+sorry
+/-
+obtain (l : ℕ) (Hl : n + l = m), from le.elim H,
+have k * n + k * l = k * m, by rewrite [-left_distrib, Hl],
+le.intro this
+-/
+
+theorem mul_le_mul_right {n m : ℕ} (k : ℕ) (H : n ≤ m) : n * k ≤ m * k :=
+mul.comm k m ▸ mul.comm k n ▸ mul_le_mul_left k H
+
+protected theorem mul_le_mul {n m k l : ℕ} (H1 : n ≤ k) (H2 : m ≤ l) : n * m ≤ k * l :=
+nat.le_trans (nat.mul_le_mul_right m H1) (nat.mul_le_mul_left k H2)
+
+protected theorem mul_lt_mul_of_pos_left {n m k : ℕ} (H : n < m) (Hk : k > 0) : k * n < k * m :=
+nat.lt_of_lt_of_le (nat.lt_add_of_pos_right Hk) (mul_succ k n ▸ nat.mul_le_mul_left k (succ_le_of_lt H))
+
+protected theorem mul_lt_mul_of_pos_right {n m k : ℕ} (H : n < m) (Hk : k > 0) : n * k < m * k :=
+mul.comm k m ▸ mul.comm k n ▸ nat.mul_lt_mul_of_pos_left H Hk
+
+/- nat is an instance of a linearly ordered semiring and a lattice -/
+
+attribute [instance]
+protected definition decidable_linear_ordered_semiring :
+decidable_linear_ordered_semiring nat :=
+⦃ decidable_linear_ordered_semiring, nat.comm_semiring,
+  add_left_cancel            := @nat.add_left_cancel,
+  add_right_cancel           := @nat.add_right_cancel,
+  lt                         := nat.lt,
+  le                         := nat.le,
+  le_refl                    := nat.le_refl,
+  le_trans                   := @nat.le_trans,
+  le_antisymm                := @nat.le_antisymm,
+  le_total                   := @nat.le_total,
+  le_iff_lt_or_eq            := @nat.le_iff_lt_or_eq,
+  le_of_lt                   := @nat.le_of_lt,
+  lt_irrefl                  := @nat.lt_irrefl,
+  lt_of_lt_of_le             := @nat.lt_of_lt_of_le,
+  lt_of_le_of_lt             := @nat.lt_of_le_of_lt,
+  lt_of_add_lt_add_left      := @nat.lt_of_add_lt_add_left,
+  add_lt_add_left            := @nat.add_lt_add_left,
+  add_le_add_left            := @nat.add_le_add_left,
+  le_of_add_le_add_left      := @nat.le_of_add_le_add_left,
+  zero_lt_one                := zero_lt_succ 0,
+  mul_le_mul_of_nonneg_left  := (take a b c H1 H2, nat.mul_le_mul_left c H1),
+  mul_le_mul_of_nonneg_right := (take a b c H1 H2, nat.mul_le_mul_right c H1),
+  mul_lt_mul_of_pos_left     := @nat.mul_lt_mul_of_pos_left,
+  mul_lt_mul_of_pos_right    := @nat.mul_lt_mul_of_pos_right,
+  decidable_lt               := nat.decidable_lt ⦄
+
+attribute [instance, priority nat.prio]
+definition nat_has_dvd : has_dvd nat :=
+has_dvd.mk has_dvd.dvd
+
+theorem add_pos_left {a : ℕ} (H : 0 < a) (b : ℕ) : 0 < a + b :=
+@add_pos_of_pos_of_nonneg _ _ a b H (zero_le b)
+
+theorem add_pos_right {a : ℕ} (H : 0 < a) (b : ℕ) : 0 < b + a :=
+sorry -- by rewrite add.comm; apply add_pos_left H b
+
+theorem add_eq_zero_iff_eq_zero_and_eq_zero {a b : ℕ} :
+a + b = 0 ↔ a = 0 ∧ b = 0 :=
+@add_eq_zero_iff_eq_zero_and_eq_zero_of_nonneg_of_nonneg _ _ a b (zero_le a) (zero_le b)
+
+theorem le_add_of_le_left {a b c : ℕ} (H : b ≤ c) : b ≤ a + c :=
+@le_add_of_nonneg_of_le _ _ a b c (zero_le a) H
+
+theorem le_add_of_le_right {a b c : ℕ} (H : b ≤ c) : b ≤ c + a :=
+@le_add_of_le_of_nonneg _ _ a b c H (zero_le a)
+
+theorem lt_add_of_lt_left {b c : ℕ} (H : b < c) (a : ℕ) : b < a + c :=
+@lt_add_of_nonneg_of_lt _ _ a b c (zero_le a) H
+
+theorem lt_add_of_lt_right {b c : ℕ} (H : b < c) (a : ℕ) : b < c + a :=
+@lt_add_of_lt_of_nonneg _ _ a b c H (zero_le a)
+
+theorem lt_of_mul_lt_mul_left {a b c : ℕ} (H : c * a < c * b) : a < b :=
+@lt_of_mul_lt_mul_left _ _ a b c H (zero_le c)
+
+theorem lt_of_mul_lt_mul_right {a b c : ℕ} (H : a * c < b * c) : a < b :=
+@lt_of_mul_lt_mul_right _ _ a b c H (zero_le c)
+
+theorem pos_of_mul_pos_left {a b : ℕ} (H : 0 < a * b) : 0 < b :=
+@pos_of_mul_pos_left _ _ a b H (zero_le a)
+
+theorem pos_of_mul_pos_right {a b : ℕ} (H : 0 < a * b) : 0 < a :=
+@pos_of_mul_pos_right _ _ a b H (zero_le b)
+
+theorem zero_le_one : (0:nat) ≤ 1 :=
+dec_trivial
+
+/- properties specific to nat -/
+
+theorem lt_intro {n m k : ℕ} (H : succ n + k = m) : n < m :=
+lt_of_succ_le (le.intro H)
+
+theorem lt_elim {n m : ℕ} (H : n < m) : ∃k, succ n + k = m :=
+le.elim (succ_le_of_lt H)
+
+theorem lt_add_succ (n m : ℕ) : n < n + succ m :=
+lt_intro (succ_add_eq_succ_add n m)
+
+theorem eq_zero_of_le_zero {n : ℕ} (H : n ≤ 0) : n = 0 :=
+sorry
+/-
+obtain (k : ℕ) (Hk : n + k = 0), from le.elim H,
+eq_zero_of_add_eq_zero_right Hk
+-/
+
+/- succ and pred -/
+
+theorem le_of_lt_succ {m n : nat} : m < succ n → m ≤ n :=
+le_of_succ_le_succ
+
+theorem lt_iff_succ_le (m n : nat) : m < n ↔ succ m ≤ n :=
+iff.rfl
+
+theorem lt_succ_iff_le (m n : nat) : m < succ n ↔ m ≤ n :=
+iff.intro le_of_lt_succ lt_succ_of_le
+
+theorem self_le_succ (n : ℕ) : n ≤ succ n :=
+le.intro (add_one n)
+
+theorem succ_le_or_eq_of_le {n m : ℕ} : n ≤ m → succ n ≤ m ∨ n = m :=
+lt_or_eq_of_le
+
+theorem pred_le_of_le_succ {n m : ℕ} : n ≤ succ m → pred n ≤ m :=
+pred_le_pred
+
+theorem succ_le_of_le_pred {n m : ℕ} : succ n ≤ m → n ≤ pred m :=
+pred_le_pred
+
+theorem pred_le_pred_of_le {n m : ℕ} : n ≤ m → pred n ≤ pred m :=
+pred_le_pred
+
+theorem pre_lt_of_lt {n m : ℕ} : n < m → pred n < m :=
+lt_of_le_of_lt (pred_le n)
+
+theorem lt_of_pred_lt_pred {n m : ℕ} (H : pred n < pred m) : n < m :=
+lt_of_not_ge
+  (suppose m ≤ n,
+    not_lt_of_ge (pred_le_pred_of_le this) H)
+
+theorem le_or_eq_succ_of_le_succ {n m : ℕ} (H : n ≤ succ m) : n ≤ m ∨ n = succ m :=
+or.imp_left le_of_succ_le_succ (succ_le_or_eq_of_le H)
+
+theorem le_pred_self (n : ℕ) : pred n ≤ n :=
+pred_le n
+
+theorem succ_pos (n : ℕ) : 0 < succ n :=
+zero_lt_succ n
+
+theorem succ_pred_of_pos {n : ℕ} (H : n > 0) : succ (pred n) = n :=
+eq.symm (or_resolve_right (eq_zero_or_eq_succ_pred n) (ne.symm (ne_of_lt H)))
+
+theorem exists_eq_succ_of_lt {n : ℕ} : Π {m : ℕ}, n < m → ∃k, m = succ k
+| 0        H := absurd H $ not_lt_zero n
+| (succ k) H := exists.intro k rfl
+
+theorem lt_succ_self (n : ℕ) : n < succ n :=
+lt.base n
+
+lemma lt_succ_of_lt {i j : nat} : i < j → i < succ j :=
+assume Plt, lt.trans Plt (self_lt_succ j)
+
+/- increasing and decreasing functions -/
+
+section
+  variables {A : Type} [strict_order A] {f : ℕ → A}
+
+  theorem strictly_increasing_of_forall_lt_succ (H : ∀ i, f i < f (succ i)) : strictly_increasing f :=
+  sorry
+  /-
+  take i j,
+  nat.induction_on j
+    (suppose i < 0, absurd this !not_lt_zero)
+    (take j', assume ih, suppose i < succ j',
+       or.elim (lt_or_eq_of_le (le_of_lt_succ this))
+         (suppose i < j', lt.trans (ih this) (H j'))
+         (suppose i = j', by rewrite this; apply H))
+  -/
+
+  theorem strictly_decreasing_of_forall_gt_succ (H : ∀ i, f i > f (succ i)) : strictly_decreasing f :=
+  sorry
+  /-
+  take i j,
+  nat.induction_on j
+    (suppose i < 0, absurd this !not_lt_zero)
+    (take j', assume ih, suppose i < succ j',
+       or.elim (lt_or_eq_of_le (le_of_lt_succ this))
+         (suppose i < j', lt.trans (H j') (ih this))
+         (suppose i = j', by rewrite this; apply H))
+  -/
+end
+
+section
+  variables {A : Type} [weak_order A] {f : ℕ → A}
+
+  theorem nondecreasing_of_forall_le_succ (H : ∀ i, f i ≤ f (succ i)) : nondecreasing f :=
+  sorry
+  /-
+  take i j,
+  nat.induction_on j
+    (suppose i ≤ 0, have i = 0, from eq_zero_of_le_zero this, by rewrite this; apply le.refl)
+    (take j', assume ih, suppose i ≤ succ j',
+       or.elim (le_or_eq_succ_of_le_succ this)
+         (suppose i ≤ j', le.trans (ih this) (H j'))
+         (suppose i = succ j', by rewrite this; apply le.refl))
+  -/
+
+  theorem nonincreasing_of_forall_ge_succ (H : ∀ i, f i ≥ f (succ i)) : nonincreasing f :=
+  sorry
+  /-
+  take i j,
+  nat.induction_on j
+    (suppose i ≤ 0, have i = 0, from eq_zero_of_le_zero this, by rewrite this; apply le.refl)
+    (take j', assume ih, suppose i ≤ succ j',
+       or.elim (le_or_eq_succ_of_le_succ this)
+         (suppose i ≤ j', le.trans (H j') (ih this))
+         (suppose i = succ j', by rewrite this; apply le.refl))
+  -/
+end
+
+/- other forms of induction -/
+
+protected definition strong_rec_on {P : nat → Type} (n : ℕ) (H : ∀n, (∀m, m < n → P m) → P n) : P n :=
+nat.rec (λm h, absurd h $ not_lt_zero _)
+  (λn' (IH : ∀ {m : ℕ}, m < n' → P m) m l,
+     or.by_cases (lt_or_eq_of_le (le_of_lt_succ l))
+    IH (λ e, eq.rec (H n' @IH) (eq.symm e))) (succ n) n $ lt_succ_self n
+
+protected theorem strong_induction_on {P : nat → Prop} (n : ℕ) (H : ∀n, (∀m, m < n → P m) → P n) :
+    P n :=
+nat.strong_rec_on n H
+
+protected theorem case_strong_induction_on {P : nat → Prop} (a : nat) (H0 : P 0)
+  (Hind : ∀(n : nat), (∀m, m ≤ n → P m) → P (succ n)) : P a :=
+nat.strong_induction_on a
+  (take n,
+   show (∀ m, m < n → P m) → P n, from
+     nat.cases_on n
+       (suppose (∀ m, m < 0 → P m), show P 0, from H0)
+       (take n,
+         suppose (∀ m, m < succ n → P m),
+         show P (succ n), from
+           Hind n (take m, assume H1 : m ≤ n, this _ (lt_succ_of_le H1))))
+
+/- pos -/
+
+theorem by_cases_zero_pos {P : ℕ → Prop} (y : ℕ) (H0 : P 0) (H1 : ∀ {y : nat}, y > 0 → P y) :
+  P y :=
+nat.cases_on y H0 (take y, H1 (succ_pos y))
+
+theorem eq_zero_or_pos (n : ℕ) : n = 0 ∨ n > 0 :=
+sorry
+/-
+or_of_or_of_imp_left
+  (or.swap (lt_or_eq_of_le !zero_le))
+  (suppose 0 = n, by subst n)
+-/
+
+theorem pos_of_ne_zero {n : ℕ} (H : n ≠ 0) : n > 0 :=
+sorry -- or.elim !eq_zero_or_pos (take H2 : n = 0, by contradiction) (take H2 : n > 0, H2)
+
+theorem ne_zero_of_pos {n : ℕ} (H : n > 0) : n ≠ 0 :=
+ne.symm (ne_of_lt H)
+
+theorem exists_eq_succ_of_pos {n : ℕ} (H : n > 0) : ∃l, n = succ l :=
+exists_eq_succ_of_lt H
+
+theorem pos_of_dvd_of_pos {m n : ℕ} (H1 : m ∣ n) (H2 : n > 0) : m > 0 :=
+sorry
+/-
+pos_of_ne_zero
+  (suppose m = 0,
+   have  n = 0, from eq_zero_of_zero_dvd (this ▸ H1),
+   ne_of_lt H2 (by subst n))
+-/
+
+/- multiplication -/
+
+theorem mul_lt_mul_of_le_of_lt {n m k l : ℕ} (Hk : k > 0) (H1 : n ≤ k) (H2 : m < l) :
+  n * m < k * l :=
+lt_of_le_of_lt (mul_le_mul_right m H1) (mul_lt_mul_of_pos_left H2 Hk)
+
+theorem mul_lt_mul_of_lt_of_le {n m k l : ℕ} (Hl : l > 0) (H1 : n < k) (H2 : m ≤ l) :
+  n * m < k * l :=
+lt_of_le_of_lt (mul_le_mul_left n H2) (mul_lt_mul_of_pos_right H1 Hl)
+
+theorem mul_lt_mul_of_le_of_le {n m k l : ℕ} (H1 : n < k) (H2 : m < l) : n * m < k * l :=
+have H3 : n * m ≤ k * m, from mul_le_mul_right m (le_of_lt H1),
+have H4 : k * m < k * l, from mul_lt_mul_of_pos_left H2 (lt_of_le_of_lt (zero_le n) H1),
+lt_of_le_of_lt H3 H4
+
+theorem eq_of_mul_eq_mul_left {m k n : ℕ} (Hn : n > 0) (H : n * m = n * k) : m = k :=
+sorry
+/-
+have n * m ≤ n * k, by rewrite H,
+have m ≤ k,         from le_of_mul_le_mul_left this Hn,
+have n * k ≤ n * m, by rewrite H,
+have k ≤ m,         from le_of_mul_le_mul_left this Hn,
+le.antisymm `m ≤ k` this
+-/
+
+theorem eq_of_mul_eq_mul_right {n m k : ℕ} (Hm : m > 0) (H : n * m = k * m) : n = k :=
+eq_of_mul_eq_mul_left Hm (mul.comm k m ▸ mul.comm n m ▸ H)
+
+theorem eq_zero_or_eq_of_mul_eq_mul_left {n m k : ℕ} (H : n * m = n * k) : n = 0 ∨ m = k :=
+or_of_or_of_imp_right (eq_zero_or_pos n)
+  (assume Hn : n > 0, eq_of_mul_eq_mul_left Hn H)
+
+theorem eq_zero_or_eq_of_mul_eq_mul_right  {n m k : ℕ} (H : n * m = k * m) : m = 0 ∨ n = k :=
+eq_zero_or_eq_of_mul_eq_mul_left (mul.comm k m ▸ mul.comm n m ▸ H)
+
+theorem eq_one_of_mul_eq_one_right {n m : ℕ} (H : n * m = 1) : n = 1 :=
+sorry
+/-
+have H2 : n * m > 0, by rewrite H; apply succ_pos,
+or.elim (le_or_gt n 1)
+  (suppose n ≤ 1,
+    have n > 0, from pos_of_mul_pos_right H2,
+    show n = 1, from le.antisymm `n ≤ 1` (succ_le_of_lt this))
+  (suppose n > 1,
+    have m > 0, from pos_of_mul_pos_left H2,
+    have n * m ≥ 2 * 1, from nat.mul_le_mul (succ_le_of_lt `n > 1`) (succ_le_of_lt this),
+    have 1 ≥ 2, from !mul_one ▸ H ▸ this,
+    absurd !lt_succ_self (not_lt_of_ge this))
+-/
+
+theorem eq_one_of_mul_eq_one_left {n m : ℕ} (H : n * m = 1) : m = 1 :=
+eq_one_of_mul_eq_one_right (mul.comm n m ▸ H)
+
+theorem eq_one_of_mul_eq_self_left {n m : ℕ} (Hpos : n > 0) (H : m * n = n) : m = 1 :=
+eq_of_mul_eq_mul_right Hpos (eq.trans H (eq.symm (one_mul n)))
+
+theorem eq_one_of_mul_eq_self_right {n m : ℕ} (Hpos : m > 0) (H : m * n = m) : n = 1 :=
+eq_one_of_mul_eq_self_left Hpos (mul.comm m n ▸ H)
+
+theorem eq_one_of_dvd_one {n : ℕ} (H : n ∣ 1) : n = 1 :=
+dvd.elim H
+  (take m, suppose 1 = n * m,
+   eq_one_of_mul_eq_one_right (eq.symm this))
+
+/- min and max -/
+open decidable
+
+attribute [simp]
+theorem min_zero (a : ℕ) : min a 0 = 0 :=
+sorry -- by rewrite [min_eq_right !zero_le]
+
+attribute [simp]
+theorem zero_min (a : ℕ) : min 0 a = 0 :=
+sorry -- by rewrite [min_eq_left !zero_le]
+
+attribute [simp]
+theorem max_zero (a : ℕ) : max a 0 = a :=
+sorry -- by rewrite [max_eq_left !zero_le]
+
+attribute [simp]
+theorem zero_max (a : ℕ) : max 0 a = a :=
+sorry -- by rewrite [max_eq_right !zero_le]
+
+attribute [simp]
+theorem min_succ_succ (a b : ℕ) : min (succ a) (succ b) = succ (min a b) :=
+sorry
+/-
+or.elim !lt_or_ge
+  (suppose a < b, by rewrite [min_eq_left_of_lt this, min_eq_left_of_lt (succ_lt_succ this)])
+  (suppose a ≥ b, by rewrite [min_eq_right this, min_eq_right (succ_le_succ this)])
+-/
+
+attribute [simp]
+theorem max_succ_succ (a b : ℕ) : max (succ a) (succ b) = succ (max a b) :=
+sorry
+/-
+or.elim !lt_or_ge
+  (suppose a < b, by rewrite [max_eq_right_of_lt this, max_eq_right_of_lt (succ_lt_succ this)])
+  (suppose a ≥ b, by rewrite [max_eq_left this, max_eq_left (succ_le_succ this)])
+-/
+
+/- In algebra.ordered_group, these next four are only proved for additive groups, not additive
+   semigroups. -/
+
+protected theorem min_add_add_left (a b c : ℕ) : min (a + b) (a + c) = a + min b c :=
+sorry
+/-
+decidable.by_cases
+  (suppose b ≤ c,
+   have a + b ≤ a + c, from add_le_add_left this _,
+   by rewrite [min_eq_left `b ≤ c`, min_eq_left this])
+  (suppose ¬ b ≤ c,
+   have c ≤ b,         from le_of_lt (lt_of_not_ge this),
+   have a + c ≤ a + b, from add_le_add_left this _,
+   by rewrite [min_eq_right `c ≤ b`, min_eq_right this])
+-/
+
+protected theorem min_add_add_right (a b c : ℕ) : min (a + c) (b + c) = min a b + c :=
+sorry -- by rewrite [add.comm a c, add.comm b c, add.comm _ c]; apply nat.min_add_add_left
+
+protected theorem max_add_add_left (a b c : ℕ) : max (a + b) (a + c) = a + max b c :=
+sorry
+/-
+decidable.by_cases
+  (suppose b ≤ c,
+   have a + b ≤ a + c, from add_le_add_left this _,
+   by rewrite [max_eq_right `b ≤ c`, max_eq_right this])
+  (suppose ¬ b ≤ c,
+   have c ≤ b,         from le_of_lt (lt_of_not_ge this),
+   have a + c ≤ a + b, from add_le_add_left this _,
+   by rewrite [max_eq_left `c ≤ b`, max_eq_left this])
+-/
+
+protected theorem max_add_add_right (a b c : ℕ) : max (a + c) (b + c) = max a b + c :=
+sorry -- by rewrite [add.comm a c, add.comm b c, add.comm _ c]; apply nat.max_add_add_left
+
+/- least and greatest -/
+
+section least_and_greatest
+  variable (P : ℕ → Prop)
+  variable [decP : ∀ n, decidable (P n)]
+  include decP
+
+  -- returns the least i < n satisfying P, or n if there is none
+  definition least : ℕ → ℕ
+    | 0        := 0
+    | (succ n) := if P (least n) then least n else succ n
+
+  theorem least_of_bound {n : ℕ} (H : P n) : P (least P n) :=
+  sorry
+  /-
+    begin
+      induction n with [m, ih],
+      rewrite ↑least,
+      apply H,
+      rewrite ↑least,
+      cases decidable.em (P (least P m)) with [Hlp, Hlp],
+      fold (least P m),
+      rewrite [if_pos Hlp],
+      apply Hlp,
+      fold (least P m),
+      rewrite [if_neg Hlp],
+      apply H
+    end
+  -/
+
+  theorem least_le (n : ℕ) : least P n ≤ n:=
+  sorry
+  /-
+    begin
+      induction n with [m, ih],
+        {rewrite ↑least},
+      rewrite ↑least,
+      cases decidable.em (P (least P m)) with [Psm, Pnsm],
+      fold (least P m),
+      rewrite [if_pos Psm],
+      apply le.trans ih !le_succ,
+      fold (least P m),
+      rewrite [if_neg Pnsm]
+    end
+  -/
+
+ theorem least_of_lt {i n : ℕ} (ltin : i < n) (H : P i) : P (least P n) :=
+ sorry
+ /-
+   begin
+     induction n with [m, ih],
+     exact absurd ltin !not_lt_zero,
+     rewrite ↑least,
+     cases decidable.em (P (least P m)) with [Psm, Pnsm],
+     fold (least P m),
+     rewrite [if_pos Psm],
+     apply Psm,
+     fold (least P m),
+     rewrite [if_neg Pnsm],
+     cases (lt_or_eq_of_le (le_of_lt_succ ltin)) with [Hlt, Heq],
+     exact absurd (ih Hlt) Pnsm,
+     rewrite Heq at H,
+     exact absurd (least_of_bound P H) Pnsm
+   end
+ -/
+
+  theorem ge_least_of_lt {i n : ℕ} (ltin : i < n) (Hi : P i) : i ≥ least P n :=
+  sorry
+  /-
+    begin
+      induction n with [m, ih],
+      exact absurd ltin !not_lt_zero,
+      rewrite ↑least,
+      cases decidable.em (P (least P m)) with [Psm, Pnsm],
+      fold (least P m),
+      rewrite [if_pos Psm],
+      cases (lt_or_eq_of_le (le_of_lt_succ ltin)) with [Hlt, Heq],
+      apply ih Hlt,
+      rewrite Heq,
+      apply least_le,
+      fold (least P m),
+      rewrite [if_neg Pnsm],
+      cases (lt_or_eq_of_le (le_of_lt_succ ltin)) with [Hlt, Heq],
+      apply absurd (least_of_lt P Hlt Hi) Pnsm,
+      rewrite Heq at Hi,
+      apply absurd (least_of_bound P Hi) Pnsm
+    end
+  -/
+
+ theorem least_lt {n i : ℕ} (ltin : i < n) (Hi : P i) : least P n < n :=
+    lt_of_le_of_lt (ge_least_of_lt P ltin Hi) ltin
+
+  -- returns the largest i < n satisfying P, or n if there is none.
+  definition greatest : ℕ → ℕ
+  | 0        := 0
+  | (succ n) := if P n then n else greatest n
+
+  theorem greatest_of_lt {i n : ℕ} (ltin : i < n) (Hi : P i) : P (greatest P n) :=
+  sorry
+  /-
+  begin
+    induction n with [m, ih],
+      {exact absurd ltin !not_lt_zero},
+      {cases (decidable.em (P m)) with [Psm, Pnsm],
+        {rewrite [↑greatest, if_pos Psm]; exact Psm},
+        {rewrite [↑greatest, if_neg Pnsm],
+          have neim : i ≠ m, from assume H : i = m, absurd (H ▸ Hi) Pnsm,
+          have ltim : i < m, from lt_of_le_of_ne (le_of_lt_succ ltin) neim,
+          apply ih ltim}}
+  end
+ -/
+  theorem le_greatest_of_lt {i n : ℕ} (ltin : i < n) (Hi : P i) : i ≤ greatest P n :=
+  sorry
+  /-
+  begin
+    induction n with [m, ih],
+      {exact absurd ltin !not_lt_zero},
+      {cases (decidable.em (P m)) with [Psm, Pnsm],
+        {rewrite [↑greatest, if_pos Psm], apply le_of_lt_succ ltin},
+        {rewrite [↑greatest, if_neg Pnsm],
+          have neim : i ≠ m, from assume H : i = m, absurd (H ▸ Hi) Pnsm,
+          have ltim : i < m, from lt_of_le_of_ne (le_of_lt_succ ltin) neim,
+          apply ih ltim}}
+  end
+  -/
+
+end least_and_greatest
+
+end nat

old_library/data/nat/pairing.lean

@@ -0,0 +1,104 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+
+Elegant pairing function.
+-/
+import data.nat.sqrt data.nat.div
+open prod decidable
+
+namespace nat
+definition mkpair (a b : nat) : nat :=
+if a < b then b*b + a else a*a + a + b
+
+definition unpair (n : nat) : nat × nat :=
+let s := sqrt n in
+if n - s*s < s then (n - s*s, s) else (s, n - s*s - s)
+
+theorem mkpair_unpair (n : nat) : mkpair (pr1 (unpair n)) (pr2 (unpair n)) = n :=
+sorry
+/-
+let s := sqrt n in
+by_cases
+  (suppose n - s*s < s,
+    begin
+      esimp [unpair],
+      rewrite [if_pos this],
+      esimp [mkpair],
+      rewrite [if_pos this, add_sub_of_le (sqrt_lower n)]
+    end)
+  (suppose h₁ : ¬ n - s*s < s,
+    have s ≤ n - s*s,                  from le_of_not_gt h₁,
+    have s + s*s ≤ n - s*s + s*s,      from add_le_add_right this (s*s),
+    have s*s + s ≤ n,                  by rewrite [nat.sub_add_cancel (sqrt_lower n) at this,
+                                              add.comm at this]; assumption,
+    have n ≤ s*s + s + s,              from sqrt_upper n,
+    have n - s*s ≤ s + s,              from calc
+        n - s*s ≤ (s*s + s + s) - s*s    : nat.sub_le_sub_right this (s*s)
+            ... = (s*s + (s+s)) - s*s    : by rewrite add.assoc
+            ... = s + s                  : by rewrite nat.add_sub_cancel_left,
+    have   n - s*s - s ≤ s,              from calc
+        n - s*s - s ≤ (s + s) - s        : nat.sub_le_sub_right this s
+                ... = s                  : by rewrite nat.add_sub_cancel_left,
+    have h₂ : ¬ s < n - s*s - s,       from not_lt_of_ge this,
+    begin
+      esimp [unpair],
+      rewrite [if_neg h₁], esimp,
+      esimp [mkpair],
+      rewrite [if_neg h₂, nat.sub_sub, add_sub_of_le `s*s + s ≤ n`],
+    end)
+-/
+
+theorem unpair_mkpair (a b : nat) : unpair (mkpair a b) = (a, b) :=
+sorry
+/-
+by_cases
+ (suppose a < b,
+  have a ≤ b + b, from calc
+    a   ≤ b   : le_of_lt this
+    ... ≤ b+b : !le_add_right,
+  begin
+    esimp [mkpair],
+    rewrite [if_pos `a < b`],
+    esimp [unpair],
+    rewrite [sqrt_offset_eq `a ≤ b + b`, nat.add_sub_cancel_left, if_pos `a < b`]
+  end)
+ (suppose ¬ a < b,
+  have   b ≤ a,           from le_of_not_gt this,
+  have a + b ≤ a + a,   from add_le_add_left this a,
+  have   a + b ≥ a,       from !le_add_right,
+  have ¬ a + b < a,     from not_lt_of_ge this,
+  begin
+    esimp [mkpair],
+    rewrite [if_neg `¬ a < b`],
+    esimp [unpair],
+    rewrite [add.assoc (a * a) a b, sqrt_offset_eq `a + b ≤ a + a`, *nat.add_sub_cancel_left,
+             if_neg `¬ a + b < a`]
+  end)
+-/
+open prod
+
+theorem unpair_lt_aux {n : nat} : n ≥ 1 → (unpair n).1 < n :=
+sorry
+/-
+suppose n ≥ 1,
+or.elim (eq_or_lt_of_le this)
+  (suppose 1 = n, by subst n; exact dec_trivial)
+  (suppose n > 1,
+   let s := sqrt n in
+   by_cases
+    (suppose h : n - s*s < s,
+      have n > 0, from lt_of_succ_lt `n > 1`,
+      have sqrt n > 0, from sqrt_pos_of_pos this,
+      have sqrt n * sqrt n > 0, from mul_pos this this,
+      begin unfold unpair, rewrite [if_pos h], esimp, exact sub_lt `n > 0` `sqrt n * sqrt n > 0` end)
+    (suppose ¬ n - s*s < s, begin unfold unpair, rewrite [if_neg this], esimp, apply sqrt_lt `n > 1` end))
+-/
+
+theorem unpair_lt : ∀ (n : nat), (unpair n).1 < succ n
+| 0        := dec_trivial
+| (succ n) :=
+  have (unpair (succ n)).1 < succ n, from unpair_lt_aux dec_trivial,
+  lt.step this
+end nat

old_library/data/nat/parity.lean

@@ -0,0 +1,292 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+
+Parity.
+-/
+-- TODO(Leo): remove after refactoring
+exit
+import data.nat.power logic.identities
+
+namespace nat
+open decidable
+
+definition even (n : nat) := n % 2 = 0
+
+attribute [instance]
+definition decidable_even : ∀ n, decidable (even n) :=
+take n, !nat.has_decidable_eq
+
+definition odd (n : nat) := ¬even n
+
+attribute [instance]
+definition decidable_odd : ∀ n, decidable (odd n) :=
+take n, decidable_not
+
+lemma even_of_dvd {n} : 2 ∣ n → even n :=
+mod_eq_zero_of_dvd
+
+lemma dvd_of_even {n} : even n → 2 ∣ n :=
+dvd_of_mod_eq_zero
+
+lemma not_odd_zero : ¬ odd 0 :=
+dec_trivial
+
+lemma even_zero : even 0 :=
+dec_trivial
+
+lemma odd_one : odd 1 :=
+dec_trivial
+
+lemma not_even_one : ¬ even 1 :=
+dec_trivial
+
+lemma odd_eq_not_even (n : nat) : odd n = ¬ even n :=
+rfl
+
+lemma odd_iff_not_even (n : nat) : odd n ↔ ¬ even n :=
+!iff.refl
+
+lemma odd_of_not_even {n} : ¬ even n → odd n :=
+suppose ¬ even n,
+iff.mpr !odd_iff_not_even this
+
+lemma even_of_not_odd {n} : ¬ odd n → even n :=
+suppose ¬ odd n,
+not_not_elim (iff.mp (not_iff_not_of_iff !odd_iff_not_even) this)
+
+lemma not_odd_of_even {n} : even n → ¬ odd n :=
+suppose even n,
+iff.mpr (not_iff_not_of_iff !odd_iff_not_even) (not_not_intro this)
+
+lemma not_even_of_odd {n} : odd n → ¬ even n :=
+suppose odd n,
+iff.mp !odd_iff_not_even this
+
+lemma odd_succ_of_even {n} : even n → odd (succ n) :=
+suppose even n,
+have n ≡ 0 [mod 2],       from this,
+have n+1 ≡ 0+1 [mod 2],   from add_mod_eq_add_mod_right 1 this,
+have h : n+1 ≡ 1 [mod 2], from this,
+by_contradiction (suppose ¬ odd (succ n),
+  have n+1 ≡ 0 [mod 2], from even_of_not_odd this,
+  have 1 ≡ 0 [mod 2],   from eq.trans (eq.symm h) this,
+  have 1 = 0,         from this,
+  by contradiction)
+
+lemma eq_1_of_ne_0_lt_2 : ∀ {n : nat}, n ≠ 0 → n < 2 → n = 1
+| 0     h₁ h₂ := absurd rfl h₁
+| 1     h₁ h₂ := rfl
+| (n+2) h₁ h₂ := absurd (lt_of_succ_lt_succ (lt_of_succ_lt_succ h₂)) !not_lt_zero
+
+lemma mod_eq_of_odd {n} : odd n → n % 2 = 1 :=
+suppose odd n,
+  have ¬ n % 2 = 0, from this,
+  have n % 2 < 2,   from mod_lt n dec_trivial,
+  eq_1_of_ne_0_lt_2 `¬ n % 2 = 0` `n % 2 < 2`
+
+lemma odd_of_mod_eq {n} : n % 2 = 1 → odd n :=
+suppose n % 2 = 1,
+by_contradiction (suppose ¬ odd n,
+  have n % 2 = 0, from even_of_not_odd this,
+  by rewrite this at *; contradiction)
+
+lemma even_succ_of_odd {n} : odd n → even (succ n) :=
+suppose odd n,
+  have n % 2 = 1 % 2,     from mod_eq_of_odd this,
+  have (n+1) % 2 = 2 % 2, from add_mod_eq_add_mod_right 1 this,
+  by rewrite mod_self at this; exact this
+
+lemma odd_succ_succ_of_odd {n} : odd n → odd (succ (succ n)) :=
+suppose odd n,
+odd_succ_of_even (even_succ_of_odd this)
+
+lemma even_succ_succ_of_even {n} : even n → even (succ (succ n)) :=
+suppose even n,
+even_succ_of_odd (odd_succ_of_even this)
+
+lemma even_of_odd_succ {n} : odd (succ n) → even n :=
+suppose odd (succ n),
+by_contradiction (suppose ¬ even n,
+  have odd n,         from odd_of_not_even this,
+  have even (succ n), from even_succ_of_odd this,
+  absurd this (not_even_of_odd `odd (succ n)`))
+
+lemma odd_of_even_succ {n} : even (succ n) → odd n :=
+suppose even (succ n),
+by_contradiction (suppose ¬ odd n,
+  have even n,       from even_of_not_odd this,
+  have odd (succ n), from odd_succ_of_even this,
+  absurd `even (succ n)` (not_even_of_odd this))
+
+lemma even_of_even_succ_succ {n} : even (succ (succ n)) → even n :=
+suppose even (n+2),
+even_of_odd_succ (odd_of_even_succ this)
+
+lemma odd_of_odd_succ_succ {n} : odd (succ (succ n)) → odd n :=
+suppose odd (n+2),
+odd_of_even_succ (even_of_odd_succ this)
+
+lemma dvd_of_odd {n} : odd n → 2 ∣ n+1 :=
+suppose odd n,
+dvd_of_even (even_succ_of_odd this)
+
+lemma odd_of_dvd {n} : 2 ∣ n+1 → odd n :=
+suppose 2 ∣ n+1,
+odd_of_even_succ (even_of_dvd this)
+
+lemma even_two_mul : ∀ n, even (2 * n) :=
+take n, even_of_dvd (dvd_mul_right 2 n)
+
+lemma odd_two_mul_plus_one : ∀ n, odd (2 * n + 1) :=
+take n, odd_succ_of_even (even_two_mul n)
+
+lemma not_even_two_mul_plus_one : ∀ n, ¬ even (2 * n + 1) :=
+take n, not_even_of_odd (odd_two_mul_plus_one n)
+
+lemma not_odd_two_mul : ∀ n, ¬ odd (2 * n) :=
+take n, not_odd_of_even (even_two_mul n)
+
+lemma even_pred_of_odd : ∀ {n}, odd n → even (pred n)
+| 0     h := absurd h not_odd_zero
+| (n+1) h := even_of_odd_succ h
+
+lemma even_or_odd : ∀ n, even n ∨ odd n :=
+λ n, by_cases
+  (λ h : even n,   or.inl h)
+  (λ h : ¬ even n, or.inr (odd_of_not_even h))
+
+lemma exists_of_even {n} : even n → ∃ k, n = 2*k :=
+λ h, exists_eq_mul_right_of_dvd (dvd_of_even h)
+
+lemma exists_of_odd : ∀ {n}, odd n → ∃ k, n = 2*k + 1
+| 0 h     := absurd h not_odd_zero
+| (n+1) h :=
+  obtain k (hk : n = 2*k), from exists_of_even (even_of_odd_succ h),
+  exists.intro k (by subst n)
+
+lemma even_of_exists {n} : (∃ k, n = 2 * k) → even n :=
+suppose ∃ k, n = 2 * k,
+obtain k (hk : n = 2 * k), from this,
+have 2 ∣ n, by subst n; apply dvd_mul_right,
+even_of_dvd this
+
+lemma odd_of_exists {n} : (∃ k, n = 2 * k + 1) → odd n :=
+assume h, by_contradiction (λ hn,
+  have even n, from even_of_not_odd hn,
+  have ∃ k, n = 2 * k, from exists_of_even this,
+  obtain k₁ (hk₁ : n = 2 * k₁ + 1), from h,
+  obtain k₂ (hk₂ : n = 2 * k₂), from this,
+  have (2 * k₁ + 1) % 2 = (2 * k₂) % 2, by rewrite [-hk₁, -hk₂],
+  begin
+    rewrite [mul_mod_right at this, add.comm at this, add_mul_mod_self_left at this],
+    contradiction
+  end)
+
+lemma even_add_of_even_of_even {n m} : even n → even m → even (n+m) :=
+suppose even n, suppose even m,
+obtain k₁ (hk₁ : n = 2 * k₁), from exists_of_even `even n`,
+obtain k₂ (hk₂ : m = 2 * k₂), from exists_of_even `even m`,
+even_of_exists (exists.intro (k₁+k₂) (by rewrite [hk₁, hk₂, left_distrib]))
+
+lemma even_add_of_odd_of_odd {n m} : odd n → odd m → even (n+m) :=
+suppose odd n, suppose odd m,
+have even (succ n + succ m),
+  from even_add_of_even_of_even (even_succ_of_odd `odd n`) (even_succ_of_odd `odd m`),
+have   even(succ (succ (n + m))), by rewrite [add_succ at this, succ_add at this]; exact this,
+even_of_even_succ_succ this
+
+lemma odd_add_of_even_of_odd {n m} : even n → odd m → odd (n+m) :=
+suppose even n, suppose odd m,
+have even (n + succ m), from even_add_of_even_of_even `even n` (even_succ_of_odd `odd m`),
+odd_of_even_succ this
+
+lemma odd_add_of_odd_of_even {n m} : odd n → even m → odd (n+m) :=
+suppose odd n, suppose even m,
+have odd (m+n), from odd_add_of_even_of_odd `even m` `odd n`,
+by rewrite add.comm at this; exact this
+
+lemma even_mul_of_even_left {n} (m) : even n → even (n*m) :=
+suppose even n,
+obtain k (hk : n = 2*k), from exists_of_even this,
+even_of_exists (exists.intro (k*m) (by rewrite [hk, mul.assoc]))
+
+lemma even_mul_of_even_right {n} (m) : even n → even (m*n) :=
+suppose even n,
+have even (n*m), from even_mul_of_even_left _ this,
+by rewrite mul.comm at this; exact this
+
+lemma odd_mul_of_odd_of_odd {n m} : odd n → odd m → odd (n*m) :=
+suppose odd n, suppose odd m,
+have even (n * succ m), from even_mul_of_even_right _ (even_succ_of_odd `odd m`),
+have even (n * m + n),  by rewrite mul_succ at this; exact this,
+by_contradiction (suppose ¬ odd (n*m),
+  have even (n*m), from even_of_not_odd this,
+  absurd `even (n * m + n)` (not_even_of_odd (odd_add_of_even_of_odd this `odd n`)))
+
+lemma even_of_even_mul_self {n} : even (n * n) → even n :=
+suppose even (n * n),
+by_contradiction (suppose odd n,
+  have odd (n * n), from odd_mul_of_odd_of_odd this this,
+  show false, from this `even (n * n)`)
+
+lemma odd_of_odd_mul_self {n} : odd (n * n) → odd n :=
+suppose odd (n * n),
+  suppose even n,
+  have even (n * n), from !even_mul_of_even_left this,
+  show false, from `odd (n * n)` this
+
+lemma odd_pow {n m} (h : odd n) : odd (n^m) :=
+nat.induction_on m
+  (show odd (n^0), from dec_trivial)
+  (take m, suppose odd (n^m),
+    show odd (n^(m+1)), from odd_mul_of_odd_of_odd h this)
+
+lemma even_pow {n m} (mpos : m > 0) (h : even n) : even (n^m) :=
+have h₁ : ∀ m, even (n^succ m),
+  from take m, nat.induction_on m
+    (show even (n^1), by rewrite pow_one; apply h)
+    (take m, suppose even (n^succ m),
+      show even (n^(succ (succ m))), from !even_mul_of_even_left h),
+obtain m' (h₂ : m = succ m'), from exists_eq_succ_of_pos mpos,
+show even (n^m), by rewrite h₂; apply h₁
+
+lemma odd_of_odd_pow {n m} (mpos : m > 0) (h : odd (n^m)) : odd n :=
+suppose even n,
+have even (n^m), from even_pow mpos this,
+show false, from `odd (n^m)` this
+
+lemma even_of_even_pow {n m} (h : even (n^m)) : even n :=
+by_contradiction
+  (suppose odd n,
+    have odd (n^m), from odd_pow this,
+    show false, from this `even (n^m)`)
+
+lemma eq_of_div2_of_even {n m : nat} : n / 2 = m / 2 → (even n ↔ even m) → n = m :=
+assume h₁ h₂,
+ or.elim (em (even n))
+   (suppose even n, or.elim (em (even m))
+     (suppose even m,
+      obtain w₁ (hw₁ : n = 2*w₁), from exists_of_even `even n`,
+      obtain w₂ (hw₂ : m = 2*w₂), from exists_of_even `even m`,
+      begin
+        substvars, rewrite [mul.comm 2 w₁ at h₁, mul.comm 2 w₂ at h₁,
+                            *nat.mul_div_cancel _ (dec_trivial : 2 > 0) at h₁, h₁]
+      end)
+     (suppose odd m,  absurd `odd m` (not_odd_of_even (iff.mp h₂ `even n`))))
+   (suppose odd n,  or.elim (em (even m))
+     (suppose even m, absurd `odd n` (not_odd_of_even (iff.mpr h₂ `even m`)))
+     (suppose odd m,
+      have d : 1 / 2 = (0:nat),   from dec_trivial,
+      obtain w₁ (hw₁ : n = 2*w₁ + 1), from exists_of_odd `odd n`,
+      obtain w₂ (hw₂ : m = 2*w₂ + 1), from exists_of_odd `odd m`,
+      begin
+        substvars,
+        rewrite [add.comm at h₁, add_mul_div_self_left _ _ (dec_trivial : 2 > 0) at h₁, d at h₁,
+                 zero_add at h₁],
+        rewrite [add.comm at h₁, add_mul_div_self_left _ _ (dec_trivial : 2 > 0) at h₁, d at h₁,
+                 zero_add at h₁],
+        rewrite h₁
+      end))
+end nat

old_library/data/nat/power.lean

@@ -0,0 +1,116 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura, Jeremy Avigad
+
+The power function on the natural numbers.
+-/
+
+-- TODO(Leo): remove after refactoring
+exit
+
+import data.nat.basic data.nat.order data.nat.div data.nat.gcd algebra.ring_power
+
+namespace nat
+
+attribute [instance, priority nat.prio]
+definition nat_has_pow_nat : has_pow_nat nat :=
+has_pow_nat.mk has_pow_nat.pow_nat
+
+theorem pow_le_pow_of_le {x y : ℕ} (i : ℕ) (H : x ≤ y) : x^i ≤ y^i :=
+pow_le_pow_of_le i !zero_le H
+
+theorem eq_zero_of_pow_eq_zero {a m : ℕ} (H : a^m = 0) : a = 0 :=
+or.elim (eq_zero_or_pos m)
+  (suppose m = 0,
+    by rewrite [`m = 0` at H, pow_zero at H]; contradiction)
+  (suppose m > 0,
+    have h₁ : ∀ m, a^succ m = 0 → a = 0,
+      begin
+        intro m,
+        induction m with m ih,
+          {krewrite pow_one; intros; assumption},
+        rewrite pow_succ,
+        intro H,
+        cases eq_zero_or_eq_zero_of_mul_eq_zero H with h₃ h₄,
+          assumption,
+        exact ih h₄
+      end,
+    obtain m' (h₂ : m = succ m'), from exists_eq_succ_of_pos `m > 0`,
+    show a = 0, by rewrite h₂ at H; apply h₁ m' H)
+
+-- generalize to semirings?
+theorem le_pow_self {x : ℕ} (H : x > 1) : ∀ i, i ≤ x^i
+| 0        := !zero_le
+| (succ j) := have x > 0,        from lt.trans zero_lt_one H,
+              have h₁ : x^j ≥ 1, from succ_le_of_lt (pow_pos_of_pos _ this),
+              have x ≥ 2,        from succ_le_of_lt H,
+              calc
+                succ j = j + 1         : rfl
+                   ... ≤ x^j + 1       : add_le_add_right (le_pow_self j)
+                   ... ≤ x^j + x^j     : add_le_add_left h₁
+                   ... = x^j * (1 + 1) : by rewrite [left_distrib, *mul_one]
+                   ... = x^j * 2       : rfl
+                   ... ≤ x^j * x       : mul_le_mul_left _ `x ≥ 2`
+                   ... = x^(succ j)    : pow_succ'
+
+-- TODO: eventually this will be subsumed under the algebraic theorems
+
+theorem mul_self_eq_pow_2 (a : nat) : a * a = a ^ 2 :=
+show a * a = a ^ (succ (succ zero)), from
+by krewrite [*pow_succ, *pow_zero, mul_one]
+
+theorem pow_cancel_left : ∀ {a b c : nat}, a > 1 → a ^ b = a ^ c → b = c
+| a 0        0        h₁ h₂ := rfl
+| a (succ b) 0        h₁ h₂ :=
+  have a = 1, by rewrite [pow_succ at h₂, pow_zero at h₂]; exact (eq_one_of_mul_eq_one_right h₂),
+  have (1:nat) < 1, by rewrite [this at h₁]; exact h₁,
+  absurd `1 <[nat] 1` !lt.irrefl
+| a 0        (succ c) h₁ h₂ :=
+  have a = 1, by rewrite [pow_succ at h₂, pow_zero at h₂]; exact (eq_one_of_mul_eq_one_right (eq.symm h₂)),
+  have (1:nat) < 1, by rewrite [this at h₁]; exact h₁,
+  absurd `1 <[nat] 1` !lt.irrefl
+| a (succ b) (succ c) h₁ h₂ :=
+  have a ≠ 0, from assume aeq0, by rewrite [aeq0 at h₁]; exact (absurd h₁ dec_trivial),
+  have a^b = a^c, by rewrite [*pow_succ at h₂]; exact (eq_of_mul_eq_mul_left (pos_of_ne_zero this) h₂),
+  by rewrite [pow_cancel_left h₁ this]
+
+theorem pow_div_cancel : ∀ {a b : nat}, a ≠ 0 → (a ^ succ b) / a = a ^ b
+| a 0        h := by rewrite [pow_succ, pow_zero, mul_one, nat.div_self (pos_of_ne_zero h)]
+| a (succ b) h := by rewrite [pow_succ, nat.mul_div_cancel_left _ (pos_of_ne_zero h)]
+
+lemma dvd_pow : ∀ (i : nat) {n : nat}, n > 0 → i ∣ i^n
+| i 0        h := absurd h !lt.irrefl
+| i (succ n) h := by rewrite [pow_succ']; apply dvd_mul_left
+
+lemma dvd_pow_of_dvd_of_pos : ∀ {i j n : nat}, i ∣ j → n > 0 → i ∣ j^n
+| i j 0        h₁ h₂ := absurd h₂ !lt.irrefl
+| i j (succ n) h₁ h₂ := by rewrite [pow_succ']; apply dvd_mul_of_dvd_right h₁
+
+lemma pow_mod_eq_zero (i : nat) {n : nat} (h : n > 0) : (i ^ n) % i = 0 :=
+iff.mp !dvd_iff_mod_eq_zero (dvd_pow i h)
+
+lemma pow_dvd_of_pow_succ_dvd {p i n : nat} : p^(succ i) ∣ n → p^i ∣ n :=
+suppose p^(succ i) ∣ n,
+have p^i ∣ p^(succ i),
+  by rewrite [pow_succ']; apply nat.dvd_of_eq_mul; apply rfl,
+dvd.trans `p^i ∣ p^(succ i)` `p^(succ i) ∣ n`
+
+lemma dvd_of_pow_succ_dvd_mul_pow {p i n : nat} (Ppos : p > 0) :
+  p^(succ i) ∣ (n * p^i) → p ∣ n :=
+by rewrite [pow_succ]; apply nat.dvd_of_mul_dvd_mul_right; apply pow_pos_of_pos _ Ppos
+
+lemma coprime_pow_right {a b} : ∀ n, coprime b a → coprime b (a^n)
+| 0        h := !comprime_one_right
+| (succ n) h :=
+  begin
+    rewrite [pow_succ'],
+    apply coprime_mul_right,
+      exact coprime_pow_right n h,
+      exact h
+  end
+
+lemma coprime_pow_left {a b} : ∀ n, coprime b a → coprime (b^n) a :=
+take n, suppose coprime b a,
+coprime_swap (coprime_pow_right n (coprime_swap this))
+end nat