import model_theory.substructures
import model_theory.bundled

--OUTPUT 1
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  have h1 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {exact h},
  have h2 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], ¬(@fintype.card m mfin : ℕ) < n, from by {
    assume (n : ℕ),
    have h3 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h1 n,
    use classical.some h3,
    have h4 : n ≤ classical.some_spec (h1 n), from classical.some_spec (h1 n),
    rw lt_iff_not_ge at h4,
    exact h4,
    },
  have h3 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], ¬(@fintype.card m mfin : ℕ) < n, from by {exact h2},
  let Γ : L.Theory := F.union (range (λ n, ∃' (@fintype.card ℕ n) ∧ ∧' (λ i : fin n, ¬(i = 0)))),
  have h4 : F.consistent Γ := by {exact Γ.compact},
  have h5 : ∃ (M : F.Model), (∀ (m : F.Model) [mfin : fintype m], ¬(@fintype.card m mfin : ℕ) < @fintype.card M M), from by {
    have h6 : F.nonempty_models Γ, from by { apply F.nonempty_of_consistent h4 },
    use classical.some h6,
    have h15 : F.consistent (F.union (range (λ (n : ℕ), ∃' (@fintype.card ℕ n) ∧ ∧' (λ (i : fin n), ¬(i = 0))))), from by {exact Γ.compact},
    have h16 : ∃ (m : F.Model) [mfin : fintype m], F.consistent (F.union (range (λ (n : ℕ), ∃' (@fintype.card ℕ n) ∧ ∧' (λ (i : fin n), ¬(i = 0)))))
      ∧ ∀ (m' : F.Model) [mfin' : fintype m'], (∃' (@fintype.card ℕ (@fintype.card m' mfin')) ∧ ∧' (λ (i : fin (@fintype.card m' mfin')), ¬(i = 0))) ⊆ M, from by {
      have h17 : ∀ (m' : F.Model) [mfin' : fintype m'], (∃' (@fintype.card ℕ (@fintype.card m' mfin')) ∧ ∧' (λ (i : fin (@fintype.card m' mfin')), ¬(i = 0))) ⊆ M, from by {
        assume (m' : F.Model) [mfin' : fintype m'],
        have h18 : (∃' (@fintype.card ℕ (@fintype.card m' mfin')) ∧ ∧' (λ (i : fin (@fintype.card m' mfin')), ¬(i = 0))) ⊆ M, from by {
          have h19 : ∃' (@fintype.card ℕ (@fintype.card m' mfin')) ∧ ∧' (λ (i : fin (@fintype.card m' mfin')), ¬(i = 0)) ⊆ M, from by {
            have h20 : ∃' (@fintype.card ℕ (@fintype.card m' mfin')) ∧ ∧' (λ (i : fin (@fintype.card m' mfin')), ¬(i = 0)) ⊆ M, from by {
              have h31 : ∃' (@fintype.card ℕ (@fintype.card m' mfin')) ∧ ∧' (λ (i : fin (@fintype.card m' mfin')), ¬(i = 0)) ⊆ M, from by {
                have h21 : ∃' (@fintype.card ℕ (@fintype.card m' mfin')), from by {
                  have h22 : ∃' (@fintype.card ℕ (@fintype.card m' mfin')), from by {
                    have h23 : ∃' (@fintype.card ℕ (@fintype.card m' mfin')), from by {
                      rw ← fintype.card_le,
                      exact ⟨(@fintype.card m' mfin')+1,nat.succ_le_succ (@fintype.card m' mfin')⟩,
                    },
                    exact ⟨h23⟩,
                  },
                  have h24 : fintype.fin (@fintype.card ℕ (@fintype.card m' mfin')), from by {
                    exact fintype.mk (@fintype.card ℕ (@fintype.card m' mfin')) (λ (n : ℕ), ⟨n,⟨@fintype.card m' mfin'⟩⟩)
                    ⟨λ (n : ℕ), @fintype.card m' mfin'⟩
                    ⟨λ (n m : ℕ), @fintype.card m' mfin'⟩,
                  },
                  exact ⟨h22,h24⟩,
                },
                have h25 : ∧' (λ (i : fin (@fintype.card m' mfin')), ¬(i = 0)), from by {
                  have h26 : ∧' (λ (i : fin (@fintype.card m' mfin')), ¬(i = 0)), from by {
                    have h27 : ∧' (λ (i : fin (@fintype.card m' mfin')), ¬(i = 0)), from by {
                      have h28 : ∧' (λ (i : fin (@fintype.card m' mfin')), ¬(i = 0)), from by {
                        have h29 : ∧' (λ (i : fin (@fintype.card m' mfin')), ¬(i = 0)), from by {
                          simp,
                          exact ⟨λ (i : fin (@fintype.card m' mfin')), ¬(i = 0)⟩,
                        },
                        exact ⟨h29⟩,
                      },
                      exact ⟨h28⟩,
                    },
                    exact ⟨h26⟩,
                  },
                  exact ⟨h25⟩,
                },
                have h30 : ∃' (@fintype.card ℕ (@fintype.card m' mfin')) ∧ ∧' (λ (i : fin (@fintype.card m' mfin')), ¬(i = 0)) ⊆ M, from by {
                  exact ⟨h21,h25⟩,
                },
                exact ⟨h30⟩,
              },
              exact ⟨h31⟩,
            },
            exact ⟨h20⟩,
          },
          exact ⟨h19⟩,
        },
        exact ⟨h17⟩,
      },
      exact ⟨h16⟩,
    },
    have h10 : ∀ n : ℕ, n ≤ @fintype.card M M, from by {
      assume (n : ℕ),
      have h11 : n ≤ @fintype.card M M, from by {
        have h12 : n ≤ @fintype.card M M, from by {
          have h13 : n ≤ @fintype.card M M, from
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  -- Let $F$ be a set of first-order formulas which has finite models of arbitrarily large size.
  assume (F : L.Theory) (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin),

  -- For each $n$, let $\mathbf A_n$ be the formula:
  let Γ : L.Theory := F,
  let A (n : ℕ) : L.Formula := F.exists (λ x, L.nne x (list.range n)),

  -- Then $\mathbf A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.
  have hA_iff : ∀ (n : ℕ) (A : F.Model) ,F.models A A n ↔ fintype.card A ≥ n, from by {
    assume (n : ℕ) (A : F.Model),
    split,
    {
      --⊢ (A ⊨ A n ) → (card A ≥ n)
      assume (h1 : F.models A A n),
      -- $A$ has at least $n$ elements
      have h2 : fintype.card A ≥ n, from by {
        --⊢ (∃ m, fintype A → card A ≥ n)
        have h3 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from exists.intro A (and.intro (by apply_instance) (by {rw nat.le_of_lt,apply nat.lt_succ_self})),
        show fintype.card A ≥ n, from by {apply exists.elim h3, assume m, cases m with mfin, apply nat.le_of_lt (mt fintype.card_le_one_iff.mp mfin.right),},
      },
      show fintype.card A ≥ n, from h2,
    },
    {
      --⊢ (card A ≥ n) → (A ⊨ A n )
      assume (h1 : fintype.card A ≥ n),

      -- Let $[a_1, ..., a_n]$ be the range of $A$
      let (A_var : fin A.σ) := list.range n.succ,
      let (A_list : list A.σ) := λ z, z.val,
      let A_range := list.range A.σ,
      have hA_var : fintype A_var, from by { apply_instance },
      have hA_list : A_list A_var = λ (z : fin A.σ), z.val, from by simp[A_list],
      have hA_range : A_range = λ (z : fin A.σ), z.val, from by simp [A_range],
      have hA_range_eq : A_list A_var = A_range, from by {rw [hA_var,hA_list,hA_range],},
      have hA_range_eq_n : A_list A_var = A_range ∧ fintype.card A_var = n.succ, from by {split,simp [hA_range_eq],rw fintype.card_range,},

      -- By Finite Union Property of Finite Models, there are $a_1, ..., a_n$ such that: $a_1 \ne a_2 \land a_1 \ne a_3 \land \ldots \land a_{n - 1} \ne a_n$
      have hA_ne : ∃ (a :  F.Model.σ → fin A_var),
        (∀ (i j : fin A_var), i ≠ j → F.Model.φ a i ≠ F.Model.φ a j ∧ F.Model.φ a i ∈ A.σ) ∧
        ∀ (i j h2 : fin A_var) (h1 : F.Model.φ a i ∈ A.σ),
          F.Model.φ a j ∈ A.σ →
          F.Model.φ a j = F.Model.φ a i, from by apply F.finite_union_property,
      -- Let: $a_1, ..., a_n$ be a model of $A$
      have hA_models_A : F.models A A n, from by {
        apply exists.elim hA_ne,
        --⊢ ∃ m, fintype A → card A ≥ n
        have h4 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {apply exists.intro A (by {split, apply_instance, rw nat.le_of_lt,show n < n.succ, from nat.lt_succ_self n,}),},
        --⊢ exists.elim h4
        assume (m : F.Model) (mfin : fintype m),
        --⊢ ∃ m ∈ list.range A.σ, fintype A → card A ≥ n
        have h5 : ∃ (m : F.Model.σ → fin A.σ), m ∈ list.range A.σ ∧ fintype A → @fintype.card (F.Model.σ → fin A.σ) m ⊆ n, from
          exists.intro (F.Model.φ ∘ (list.range n.succ).val)
          (and.intro (by {rw hA_range_eq,}) (by {rw fintype.card_range,rw nat.le_iff_lt_or_eq,rw nat.le_iff_lt_or_eq,rw nat.lt_succ_iff,rw nat.le_iff_lt_or_eq,rw nat.le_iff_lt_or_eq,rw nat.lt_succ_iff,apply mt fintype.card_le_one_iff.mp,apply and.right,apply and.left,})),

        --⊢ (exists.elim h5)
        assume (m : F.Model.σ → fin A_var) (h5_1 : m ∈ list.range A.σ) (h5_2 : fintype A → @fintype.card (F.Model.σ → fin A_var) m ⊆ n),
        --⊢ (∀ x, x ∈ list.range A.σ → @fintype.card (F.Model.σ → fin A_var) x ≤ @fintype.card (F.Model.σ → fin A_var) m)
        have h6 : ∀ x, x ∈ list.range A.σ → fintype.card x ≤ fintype.card m, from
          (list.forall_mem_range).mp (by {apply set.forall_le_iff.mp h5_2,}),
        --⊢ (A ⊨ A n )
        show F.models A A n, from
          F.models_of_mem_models (and.left hA_ne) hA_range_eq_n.right (list.mem_range A.σ) h1,
      },

      -- Hence $A$ has at least $n$ elements.
      have h2 : fintype.card A ≥ n, from by {apply hA_iff,from hA_models_A},
      show fintype.card A ≥ n, from h2,
    },
  },

  -- Take:
  -- $$ \Gamma := F \cup \bigcup_{i \mathop = 1}^\infty A_i $$
  let Γ : L.Theory := by {apply set.union, apply F, apply classical.some (exists_eq_fintype.mp h),},

  -- Since $F$ has models of arbitrarily large size, every finite subset of $\Gamma$ is satisfiable.
  have h_models : ∀ (Γ : set L.Formula) (h_finite : finite Γ), ∃ (A : F.Model), F.satisfiable A Γ, from by {
    assume (Γ : set L.Formula
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  rcases h 1 with ⟨M,mfinM,h⟩,

  have h2 : 1 ≤ @fintype.card M mfinM, from h,
  have h3 : @fintype.card M mfinM = 1, from le_antisymm h h2,
  -- this is a contradiction
  have h4 : fintype M, from card_le_one.elim2 h3,
  have h5 : ¬ infinite M, from not_infinite_iff_finite.mpr h4,
  contradiction,
end

--OUTPUT 4
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  let ψ_n := λ n : ℕ, list_to_set L.predicates $
    ((list.range n).pmap (λ i j, (L.symb ∘ L.fns) i ≠ (L.symb ∘ L.fns) j)).map @nonempty.elim,
  let ψ := (∪) (range ψ_n),
  have h1 : ∀ n : ℕ, ∀ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin → ⊨' ψ_n n m, from
    assume n : ℕ, assume (m : F.Model) [mfin : fintype m] (hmn : n ≤ @fintype.card m mfin), have
      h₀ : ∃ (i : fin m.n) (j : fin m.n), ¬(i = j), from fintype.exists_ne mfin,
    have h₁ : ∃ (i : fin m.n) (j : fin m.n) (hneij : i ≠ j),
      from fintype.exists_ne_of_card_eq_succ hmn,
    have h₂ : ∀ i, ∀ j, ∀ hneij, (λ (i : fin n) (j : fin n), (L.symb ∘ L.fns) i ≠ (L.symb ∘ L.fns) j) i j, from
      assume i : fin m.n, assume j : fin m.n, assume hneij : i ≠ j,
      have h₃ : ∀ f : ℕ → L.predicates, ∀ i j : fin (m.n), (f i ≠ f j), from assume f : ℕ → L.predicates,
      assume i : fin m.n, assume j : fin m.n, assume hfneij : f i ≠ f j, have h₄ : ∀ x : ℕ, ∀ y : ℕ, ∀ hneij : x ≠ y,
        L.predicates.injective ((L.symb ∘ L.fns) : fin m.n → L.predicates) hfneij, from
        assume x : ℕ, assume y : ℕ, assume hneij : x ≠ y, have h₅ : ∀ x : ℕ, ∀ y : ℕ, ∀ hneij : x ≠ y,
          L.predicates.injective L.symb hfneij, from assume x : ℕ, assume y : ℕ, assume hneij : x ≠ y,
          L.symb.injective L.symb hfneij, have h₆ : ∀ x : ℕ, ∀ y : ℕ, ∀ hneij : x ≠ y, L.fns x ≠ L.fns y, from
          assume x : ℕ, assume y : ℕ, assume hneij : x ≠ y, have h₇ : ∀ x : ℕ, ∀ y : ℕ, ∀ hneij : x ≠ y,
            L.predicates.injective (L.symb ∘ L.fns) hfneij, from assume x : ℕ, assume y : ℕ, assume hneij : x ≠ y,
            L.predicates.injective L.symb hfneij, have h₈ : ∀ x : ℕ, ∀ y : ℕ, ∀ hneij : x ≠ y, L.fns x ≠ L.fns y,
          from assume x : ℕ, assume y : ℕ, assume hneij : x ≠ y, L.fns.injective hfneij, have h₉ :
            ∀ x : fin m.n, ∀ y : fin m.n, ∀ hneij : x ≠ y, L.fns x ≠ L.fns y, from assume x : fin m.n, assume y : fin m.n,
            assume hneij : x ≠ y, have h₁₀ : ∀ i : fin m.n, ∀ j : fin m.n, ∀ hneij : i ≠ j, L.symb (L.fns i) ≠ L.symb (L.fns j),
            from assume i : fin m.n, assume j : fin m.n, assume hneij : i ≠ j, have h₁₁ : ∀ i : fin m.n, ∀ j : fin m.n, ∀ hneij : i ≠ j,
              L.symb (L.fns i) ≠ L.symb (L.fns j), from assume i : fin m.n, assume j : fin m.n, assume hneij : i ≠ j,
              L.predicates.injective L.symb hfneij, have h₁₂ : ∀ i : fin m.n, ∀ j : fin m.n, ∀ hneij : i ≠ j,
              L.symb (L.fns i) ≠ L.symb (L.fns j), from h₁₁ i j hneij, have h₁₃ : ∀ i : fin m.n, ∀ j : fin m.n, ∀ hneij : i ≠ j,
              L.fns i ≠ L.fns j, from by apply h₉, h₁₃ x y hneij, have h₁₄ : ∀ x : ℕ, ∀ y : ℕ, ∀ hneij : x ≠ y, L.fns x ≠ L.fns y,
            from by rw [← fin.cast_up, ← fin.cast_up, h₉], have h₁₅ : ∀ x : ℕ, ∀ y : ℕ, ∀ hneij : x ≠ y, L.fns x ≠ L.fns y, from h₁₄,
            have h₁₆ : ∀ x : ℕ, ∀ y : ℕ, ∀ hneij : x ≠ y, L.fns x ≠ L.fns y, from assume x : ℕ, assume y : ℕ, assume hneij : x ≠ y,
              have h₁₇ : ∀ x : ℕ, ∀ y : ℕ, ∀ hneij : x ≠ y, L.fns x ≠ L.fns y, from by apply h₁₄, have h₁₈ : ∀ x : ℕ, ∀ y : ℕ, ∀ hneij : x ≠ y,
                L.fns x ≠ L.fns y, from h₁₇ x y hneij, have h₁₉ : ∀ x : ℕ, ∀ y : ℕ, ∀ hneij : x ≠ y, L.fns x ≠ L.fns y, from assume x : ℕ, assume y : ℕ,
                assume hneij : x ≠ y, have h₂₀ : ∀ x : ℕ, ∀ y : ℕ, ∀ hneij : x ≠ y, L.fns x ≠ L.fns y, from have h₂₁ : ∀ x : ℕ,
                  ∀ y : ℕ, ∀ hneij : x ≠ y, L.fns x ≠ L.fns y, from assume x : ℕ, assume y : ℕ, assume hneij : x ≠ y,
                  have h₂₂ : ∀ x : ℕ, ∀ y : ℕ, ∀ hneij : x ≠ y, L.fns x ≠ L.fns y, from by apply h₁₄, have h₂₃ :
                  ∀ x : ℕ, ∀ y : ℕ,
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  -- let F be a set of first-order formulas which has finite models of arbitrarily large size
  assume F : L.Theory,
  assume h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin,

  -- let A_n be the formula $\exists x_1 \exists x_2 \ldots \exists x_n: \{x_1 \ne x_2 \land x_1 \ne x_3 \land \ldots \land x_{n - 1} \ne x_n\}$
  let A_n :=  exists (x1 : F.struct.σ) $ exists (x2 : F.struct.σ) $ exists (x3 : F.struct.σ)
    (n - 3) ⟨x2 ≠ x3, by apply nat.le_pred a⟩
    (∃ x_1 ∃ x_2 ∃ x_3 (n - 3) (⟨x_2 ≠ x_3, by apply nat.le_pred a⟩)
    (∀ x_1 ∀ x_2 ∀ x_3 (n - 3) (⟨x_2 ≠ x_3, by apply nat.le_pred a⟩)
    ∃ x_n (n - 1) (⟨x_1 ≠ x_n, by apply nat.le_pred a⟩)),

  -- Gamma is the union of F and the above formula for all values of n
  let Gamma := F.set ∪ (∪ i : ℕ, A_n i)

  -- We know that every finite subset of Gamma is satisfiable.
  have h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from
    assume (n : ℕ), h n,

  -- The compactness theorem tells us Gamma is satisfiable in some model
  have h3 : ∃ (M : F.Model), M ⊨ Gamma, from by apply compactness Gamma,

  -- this model must be infinite since for each value of n, the above formula has a solution
  have h4 : ∃ (M : F.Model), infinite M, from ⟨classical.some h3, assume x : M,
    classical.some_spec h3 ⟨x, assume ⟨w,(h₁ : w ∈ F.set) | (h₂ : w ∈ A_n)⟩,
      begin
        -- w is either in F or one of the n formulas
        assume h₁ | h₂,
        {
          -- w is in F
          assume h₁,
          have h5 : F ⊨ w, from ⟨w,assume h₁,h₁, h₁⟩,
          have h6 : M ⊨ w, from classical.some_spec h3 ⟨w, h5⟩,
          exact h6 x,
        },
        {
          -- w is in the n formulas
          assume h₂,

          -- w is a formula of the form $\exists x_1 \exists x_2 \ldots \exists x_n: \{x_1 \ne x_2 \land x_1 \ne x_3 \land \ldots \land x_{n - 1} \ne x_n\}$
          have h7 : ∃ (x_1 : F.struct.σ) ∃ (x_2 : F.struct.σ) ∃ (x_3 : F.struct.σ) (n - 3)
            ⟨x_2 ≠ x_3, by apply nat.le_pred a⟩ ∃ x_n (n - 1) ⟨x_1 ≠ x_n, by apply nat.le_pred a⟩,
            from classical.some_spec h3 ⟨w,h₂⟩,

          have h8 : ∃ (x_1 : F.struct.σ) ∃ (x_2 : F.struct.σ) ∃ (x_3 : F.struct.σ) (n - 3)
            (⟨x_2 ≠ x_3, by apply nat.le_pred a⟩) ∃ x_n (n - 1) ⟨x_1 ≠ x_n, by apply nat.le_pred a⟩,
            from h7,

          have h9 : ∃ (x_1 : F.struct.σ) ∃ (x_2 : F.struct.σ) ∃ (x_3 : F.struct.σ) (n - 3)
            (⟨x_2 ≠ x_3, by apply nat.le_pred a⟩) ∃ x_n (n - 1) ⟨x_1 ≠ x_n, by apply nat.le_pred a⟩,
            from h8,

          -- set x to be the value of x_n
          have h10 : x ≠ F.struct.σ (n - 3), from classical.some_spec h9.right.right.right.right,
          have h11 : x ≠ F.struct.σ (n - 2), from classical.some_spec h9.right.right.right,
          have h12 : x ≠ F.struct.σ (n - 1), from classical.some_spec h9.right,

          -- x_n is an element of the model, so x is an element of the model
          have h13 : x ∈ M, from classical.some_spec h9.left.right.right.left.right,

          -- the model is infinite since it has at least n elements
          have h14 : infinite M, from classical.some_spec h3.right n,
          show ∃ x : M, true, from ⟨x,true.intro⟩,
        },
      end,
      classical.some_spec h3 ⟨w,h₁⟩⟩⟩,
  exact h4
end

--OUTPUT 6
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  -- Let $F$ be a set of first-order formulas which has finite models of arbitrarily large size.
  assume (L : first_order.language) (F : L.Theory) (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin),
  -- Then $F$ has an infinite model.

  -- For each $n$, let $\mathbf A_n$ be the formula:
  let (An : L.formula) (n : ℕ) :=
  begin
    have : ∃ x1 : L.sort, ∃ x2 : L.sort, ⋀ i : fin 2, x1 ≠ x2, from
      ⟨L.variable (L.sort 1) 0, L.variable (L.sort 1) 1, assume i : fin 2, begin cases i, refl, end⟩,
    let x : L.variable (L.sort 1) := (this).1,
    let y : L.variable (L.sort 1) := (this).2,
    use L.exists' (L.variable (L.sort 1) 0) (L.exists' (L.variable (L.sort 1) 1) (L.forall' ℕ 2 (λ i, L.ne x y))),
  end,
  -- Then $A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.
  have hAn : ∀ n : ℕ, (F.Model) → Prop := λ n, (λ m, ∃ (l : list (L.sort m)), card (set.range (@list.to_finset m l)) = n),
  have hAn1 : ∀ n : ℕ, (F.Model) → Prop := λ n, (λ m, ∃ (l : list (L.sort m)), card (set.range (@list.to_finset m l)) ≠ n),

  -- Take:
  let Γ : list L.formula := F.axioms ++ (list.univ (λ n : ℕ, An n)),
  -- Since $F$ has models of arbitrarily large size, every finite subset of $\Gamma$ is satisfiable.
  have hΓ_sat : ∀ Γ' : list L.formula, (Γ'.length ≤ Γ.length) → F.satisfiable Γ', from assume Γ' : list L.formula,
    assume h : Γ'.length ≤ Γ.length,
    show F.satisfiable Γ', from begin
      -- Let $n$ be the number of formulas in $\Gamma'$
      let n : ℕ := Γ'.length,
      -- Since $F$ has models of arbitrarily large size,
      have h1 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from (hF _),
      -- Let $m$ be a model of $F$ with more than $n$ elements
      let m : F.Model := classical.some h1.1,
      have h1' : fintype m, from (classical.some_spec h1.1).2,
      have h1'' : n ≤ @fintype.card m h1', from (classical.some_spec h1.1).1,

      -- then Γ' is satisfiable in $m$
      have h2 : @F.satisfiable m h1' Γ', from begin
        show @F.satisfiable m h1' Γ', from by {
          -- $F$ is satisfiable in $m$
          have h3 : @F.satisfiable m h1' F.axioms, from by apply @F.satisfiable_of_satisfiable _ h1' F.axioms,
          -- and $A_n$ is satisfiable in $m$
          have h4 : @F.satisfiable m h1' (An (n + 1)), from by {
            have h5 : m ⊨ (An (n + 1)), from begin
              -- $\Gamma'$ has $n$ formulas
              have h6 : Γ'.length = n, from by simp,
              have h7 : exists s : L.sort m, ∃ l : list (L.sort m), card (set.range (list.to_finset s l)) = n, from begin
                -- Let $n$ be the number of formulas in $\Gamma'$
                let n : ℕ := Γ'.length,
                -- Since $F$ has models of arbitrarily large size,
                have h1 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from (hF _),
                -- Let $m$ be a model of $F$ with more than $n$ elements
                let m : F.Model := classical.some h1.1,
                have h1' : fintype m, from (classical.some_spec h1.1).2,
                have h1'' : n ≤ @fintype.card m h1', from (classical.some_spec h1.1).1,
                let s : L.sort m := L.sort 1,
                have h5 : ∀ {n : ℕ} {α : Type n} [fintype α] (l : list (L.sort α)), card (set.range (list.to_finset s l)) = n → ∃ l' : list (L.sort α), card (set.range (list.to_finset s l')) = n + 1, from assume n α fintype_α l h,
                  by {
                    assume h,
                    have h' : ∀ (l : list (L.sort α)), ∃ s', fintype s' ∧ s' ≠ (L.sort α), from assume l,
                      by {
                        have h' : ∃ (n : ℕ) (m : n), ∃ (α' : L.sort α) (a : n), ∃ (β : Type n),
                          ∃ (f : L.sort α → L.sort α → Type n), ∀ (a' : n), ∃ (b : Type n), ∃ (g : L.sort α → L.sort α → b),
                          ∃ (h : b → b → Type n), f a' a' = h (g a' a') (g a' a'),
                          from begin
                            have h' : @fintype.card (L.sort (L.sort α)) _ ≠ 0, from by {
                              have h' : 0 ≤ @fintype.card (L.sort (L.sort α)) _, from by {
                                apply (set.card_pos_iff_ne_empty).mp,
                                have h' : (∃ (n : ℕ) (m : n), ∃ (α' : L.sort α) (a : n), ∃ (β : Type n), ∃ (f : α' → α' → β), ∀ (a' : n), ∃ (b : Type n), ∃ (g : α' → α' → b), ∃ (h : b → b → Type n), f a' a' = h (g a' a') (g a' a')), from by {
                                  use 1,
                                  use 0,
                                  use (L.variable (L.sort α) 0),
                                  use 0,
                                  use bool,
                                  use eq,
                                  assume a' : 1,
                                  use bool,
                                  use eq,
                                  use eq.refl ff,
                                },
                                exact ne_empty_of_mem h',
                              },
                              have h' : 0 < @fintype.card (L.sort (L.sort α)) _, from begin
                                apply nat.lt_of_le_of_ne,
                                exact h',
                                assume h',
                                rw h',
                                exact (dec_trivial : 0 ≠ 1),
                              end,
                              have h' : { l : list (L.sort (L.sort α)) // card (set.range (list.to_finset (L.sort (L.sort α))
end --Needs more than 2000 tokens!

--OUTPUT 7
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  sorry
end

--OUTPUT 8
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  have h1 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by exact h,
  have h2 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h3 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h4 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h5 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h6 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h7 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h8 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h9 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h10 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h11 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h12 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h13 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h14 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h15 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h16 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h17 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h18 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h19 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h20 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h21 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right,
  },
  have h22 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    cases (h1 n) with m hm,
    use m,
    use hm.left,
    exact hm.right
end --Needs more than 2000 tokens!

--OUTPUT 9
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  -- There is a formula consisting of a set of first-order formulas:
  -- ∀ i, exists x1,x2,…,xn such that {x1!=x2 && x1!=x3 && x2!=x3 && x2!=x4 && x3!=x4 && … && x(n-1)!=xn}
  -- This formula is true iff there are at least n elements
  have hAi : ∀ (n : ℕ), ∃ Ai : F.Formula, @F.formula.satisfies L F Ai (finset.univ) (λ x, ⟨x, ⟨n,finset.singleton_eq_singleton.mp (by {exact finset.mem_univ x})⟩⟩) = ff,
  {
    assume n : ℕ,
    use (finset.univ.bexists $ λ (x1 : F.Model) (h1 : ∃ h1 : fintype x1, n ≤ @fintype.card x1 h1),
            finset.univ.bexists $ λ (x2 : F.Model) (h2 : ∃ h2 : fintype x2, n ≤ @fintype.card x2 h2),
              finset.univ.bexists $ λ (x3 : F.Model) (h3 : ∃ h3 : fintype x3, n ≤ @fintype.card x3 h3),
                (x1 ≠ x2) ∧ (x1 ≠ x3) ∧ (x2 ≠ x3) ),
    assume x : F.Model,
    have h1 : ∀ x : F.Model, ∃ (h1 : fintype x), n ≤ @fintype.card x h1, from assume x : F.Model, h n,
    assume hx : @F.formula.satisfies L F (finset.univ.bexists $ λ (x1 : F.Model) (h1 : ∃ h1 : fintype x1, n ≤ @fintype.card x1 h1),
            finset.univ.bexists $ λ (x2 : F.Model) (h2 : ∃ h2 : fintype x2, n ≤ @fintype.card x2 h2),
              finset.univ.bexists $ λ (x3 : F.Model) (h3 : ∃ h3 : fintype x3, n ≤ @fintype.card x3 h3),
                (x1 ≠ x2) ∧ (x1 ≠ x3) ∧ (x2 ≠ x3) ) (finset.univ) (λ x, ⟨x, ⟨n,finset.singleton_eq_singleton.mp (by {exact finset.mem_univ x})⟩⟩) = ff,
    have h2 : n ≤ @fintype.card x ⟨x, by {exact finset.mem_univ x}⟩, from @F.formula.satisfies_of_mem L F
      (finset.univ.bexists $ λ (x1 : F.Model) (h1 : ∃ h1 : fintype x1, n ≤ @fintype.card x1 h1),
            finset.univ.bexists $ λ (x2 : F.Model) (h2 : ∃ h2 : fintype x2, n ≤ @fintype.card x2 h2),
              finset.univ.bexists $ λ (x3 : F.Model) (h3 : ∃ h3 : fintype x3, n ≤ @fintype.card x3 h3),
                (x1 ≠ x2) ∧ (x1 ≠ x3) ∧ (x2 ≠ x3) ) (finset.univ) (λ x, ⟨x, ⟨n,finset.singleton_eq_singleton.mp (by {exact finset.mem_univ x})⟩⟩) (ff)
      hx ⟨x, by {exact finset.mem_univ x}⟩,
    show ∃ (hx : fintype x), n ≤ @fintype.card x hx, from ⟨x, h2⟩,
  },

  -- ∀ i, exists Ai, false if Ai is true
  -- This is a contradiction to compactness:
  -- there exists Ai and false if Ai is true for all i
  have h1 : ∃ (Ai : ℕ → F.Formula), (∀ (n : ℕ), ∃ (x : F.Model), F.formula.satisfies Ai n x = ff)
      ∧ (∀ (n : ℕ), @F.formula.satisfies L F (Ai n) (finset.univ) (λ x, ⟨x, ⟨n,finset.singleton_eq_singleton.mp (by {exact finset.mem_univ x})⟩⟩) = ff),
  {
    use hAi,
    obviously,
  },

  -- F has infinite models
  exact F.model.infinite_of_satisfies_unbounded_formula h1,
end

--OUTPUT 10
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  -- Define the formula $\mathbf A_n$
  def Γ : F.Theory :=
    F.union (∪ (range (λ n, (∃ (x₁ : M), ∃ (x₂ : M),
    ∃ (a : Π {i : ℕ}, fin i → M), (∃ (b : Π {i : ℕ}, fin i → M),
    ∃ (c : Π {i : ℕ}, fin i → M), (∃ (d : Π {i : ℕ}, fin i → M),
    ∃ (e : Π {i : ℕ}, fin i → M),
    (∃ (f : Π {i : ℕ}, fin i → M),
    ∃ (g : Π {i : ℕ}, fin i → M),
    ∃ (h : Π {i : ℕ}, fin i → M),
    ∃ (p : Π {i : ℕ}, fin i → M),
    ∃ (q : Π {i : ℕ}, fin i → M),
    ∃ (r : Π {i : ℕ}, fin i → M),
    ∃ (s : Π {i : ℕ}, fin i → M),
    ∃ (t : Π {i : ℕ}, fin i → M),
    ∃ (u : Π {i : ℕ}, fin i → M),
    ∃ (v : Π {i : ℕ}, fin i → M),
    ∃ (w : Π {i : ℕ}, fin i → M),
    ∃ (z : Π {i : ℕ}, fin i → M),
    ∃ (y : Π {i : ℕ}, fin i → M),
    ∃ (α : Π {i : ℕ}, fin i → M),
    ∃ (β : Π {i : ℕ}, fin i → M),
    ∃ (χ : Π {i : ℕ}, fin i → M),
    ∃ (ψ : Π {i : ℕ}, fin i → M),
    ∃ (ω : Π {i : ℕ}, fin i → M),
    ∃ (∅ : Π {i : ℕ}, fin i → M),
    ∃ (δ : Π {i : ℕ}, fin i → M),
    ∃ (ε : Π {i : ℕ}, fin i → M),
    neq L x₁ x₂ ∧ neq L x₁ x₃ ∧ neq L x₁ x₄ ∧ neq L x₁ x₅ ∧ neq L x₁ x₆ ∧ neq L x₁ x₇ ∧ neq L x₁ x₈ ∧ neq L x₁ x₉ ∧ neq L x₁ x₁₀ ∧ neq L x₁ x₁₁ ∧ neq L x₁ x₁₂ ∧ neq L x₁ x₁₃ ∧ neq L x₁ x₁₄ ∧ neq L x₁ x₁₅ ∧ neq L x₁ x₁₆ ∧ neq L x₁ x₁₇ ∧ neq L x₁ x₁₈ ∧ neq L x₁ x₁₉ ∧ neq L x₁ x₂₀ ∧ neq L x₁ x₂₁ ∧ neq L x₁ x₂₂ ∧ neq L x₁ x₂₃ ∧ neq L x₁ x₂₄ ∧ neq L x₁ x₂₅ ∧ neq L x₁ x₂₆ ∧ neq L x₁ x₂₇ ∧ neq L x₁ x₂₈ ∧ neq L x₁ x₂₉ ∧ neq L x₁ x₃₀ ∧ neq L x₁ x₃₁ ∧ neq L x₁ x₃₂ ∧ neq L x₁ x₃₃ ∧ neq L x₁ x₃₄ ∧ neq L x₁ x₃₅ ∧ neq L x₁ x₃₆ ∧ neq L x₁ x₃₇ ∧ neq L x₁ x₃₈ ∧ neq L x₁ x₃₉ ∧ neq L x₁ x₄₀ ∧ neq L x₁ x₄₁ ∧ neq L x₁ a₀ ∧ neq L x₁ b₀ ∧ neq L x₁ c₀ ∧ neq L x₁ d₀ ∧ neq L x₁ e₀ ∧ neq L x₁ f₀ ∧ neq L x₁ g₀ ∧ neq L x₁ h₀ ∧ neq L x₁ p₀ ∧ neq L x₁ q₀ ∧ neq L x₁ r₀ ∧ neq L x₁ s₀ ∧ neq L x₁ t₀ ∧ neq L x₁ u₀ ∧ neq L x₁ v₀ ∧ neq L x₁ w₀ ∧ neq L x₁ z₀ ∧ neq L x₁ y₀ ∧ neq L x₁ α₀ ∧ neq L x₁ β₀ ∧ neq L x₁ χ₀ ∧ neq L x₁ ψ₀ ∧ neq L x₁ ω₀ ∧ neq L x₁ ∅₀ ∧ neq L x₁ δ₀ ∧ neq L x₁ ε₀ ∧ neq L x₂ x₃ ∧ neq L x₂ x₄ ∧ neq L x₂ x₅ ∧ neq L x₂ x₆ ∧ neq L x₂ x₇ ∧ neq L x₂ x₈ ∧ neq L x₂ x₉ ∧ neq L x₂ x₁₀ ∧ neq L x₂ x₁₁ ∧ neq L x₂ x₁₂ ∧ neq L x₂ x₁₃ ∧ neq L x₂ x₁₄ ∧ neq L x₂ x₁₅ ∧ neq L x₂ x₁₆ ∧ neq L x₂ x₁₇ ∧ neq L x₂ x₁₈ ∧ neq L x₂ x₁₉ ∧ neq L x₂ x₂₀ ∧ neq L x₂ x₂₁ ∧ neq L x₂ x₂₂ ∧ neq L x₂ x₂₃ ∧ neq L x₂ x₂₄ ∧ neq L x₂ x₂₅ ∧ neq L x₂ x₂₆ ∧ neq L x₂ x₂₇ ∧ neq L x₂ x₂₈ ∧ neq L x₂ x₂₉ ∧ neq L x₂ x₃₀
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Overflow theorem
Let $F$ be a set of first-order formulas which has finite models of arbitrarily large size. Then $F$ has an infinite model.
`proof`
For each $n$, let $\mathbf A_n$ be the formula:

$\exists x_1 \exists x_2 \ldots \exists x_n: \{x_1 \ne x_2 \land x_1 \ne x_3 \land \ldots \land x_{n - 1} \ne x_n\}$

Then $\mathbf A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.

Take:
$$ \Gamma := F \cup \bigcup_{i \mathop = 1}^\infty A_i $$

Since $F$ has models of arbitrarily large size, every finite subset of $\Gamma$ is satisfiable.

From the Compactness Theorem, $\Gamma$ is satisfiable in some model $\mathbf{M}$.

But since $\mathbf{M} \models A_i$ for each $i$, $\mathbf{M}$ must be infinite.

So $F$ has an infinite model.

QED
-/
theorem  overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
FEW SHOT PROMPTS TO CODEX(END)-/


import data.complex.basic
import algebra.field

theorem cpge_group_3_a {G1 : Type*} [group G1] {G2 : Type*} [group G2]
                      (H : (subgroup G1)) (f : (G1 →* G2) ) : is_subgroup (f '' H) := sorry


import .lib .integers .floats .maps .errors

namespace ast
open integers maps errors floats

/- * Syntactic elements -/

/- Identifiers (names of local variables, of global symbols and functions,
  etc) are represented by the type [positive] of positive integers. -/

def ident := pos_num

instance pos_num_eq : decidable_eq pos_num := by tactic.mk_dec_eq_instance
instance ident_eq : decidable_eq ident := by tactic.mk_dec_eq_instance

/- The intermediate languages are weakly typed, using the following types: -/

inductive typ : Type
| Tint                /- 32-bit integers or pointers -/
| Tfloat              /- 64-bit double-precision floats -/
| Tlong               /- 64-bit integers -/
| Tsingle             /- 32-bit single-precision floats -/
| Tany32              /- any 32-bit value -/
| Tany64              /- any 64-bit value, i.e. any value -/

def typ.Tptr : typ := if archi.ptr64 then typ.Tlong else typ.Tint
open typ

instance typ_eq : decidable_eq typ := by tactic.mk_dec_eq_instance

def typesize : typ → ℤ
| Tint    := 4
| Tfloat  := 8
| Tlong   := 8
| Tsingle := 4
| Tany32  := 4
| Tany64  := 8

lemma typesize_pos (ty) : typesize ty > 0 :=
by cases ty; exact dec_trivial

lemma typesize_Tptr : typesize Tptr = if archi.ptr64 then 8 else 4 :=
by delta Tptr; cases archi.ptr64; refl

/- All values of size 32 bits are also of type [Tany32].  All values
  are of type [Tany64].  This corresponds to the following subtyping
  relation over types. -/

def subtype : typ → typ → bool
| Tint    Tint    := tt
| Tlong   Tlong   := tt
| Tfloat  Tfloat  := tt
| Tsingle Tsingle := tt
| Tint    Tany32  := tt
| Tsingle Tany32  := tt
| Tany32  Tany32  := tt
| _       Tany64  := tt
| _       _       := ff

def subtype_list : list typ → list typ → bool
| [] [] := tt
| (ty1::tys1) (ty2::tys2) := subtype ty1 ty2 && subtype_list tys1 tys2
| _ _ := ff

/- Additionally, function definitions and function calls are annotated
  by function signatures indicating:
- the number and types of arguments;
- the type of the returned value, if any;
- additional information on which calling convention to use.

These signatures are used in particular to determine appropriate
calling conventions for the function. -/

structure calling_convention : Type := mkcallconv ::
(cc_vararg : bool)                      /- variable-arity function -/
(cc_unproto : bool)                     /- old-style unprototyped function -/
(cc_structret : bool)                   /- function returning a struct  -/

instance calling_convention_eq : decidable_eq calling_convention := by tactic.mk_dec_eq_instance

def cc_default : calling_convention :=
{ cc_vararg := false, cc_unproto := false, cc_structret := false }

structure signature : Type :=
(sig_args : list typ)
(sig_res : option typ)
(sig_cc : calling_convention)

def proj_sig_res (s : signature) : typ :=
s.sig_res.get_or_else Tint

instance signature_eq : decidable_eq signature := by tactic.mk_dec_eq_instance

def signature_main : signature :=
{ sig_args := [], sig_res := some Tint, sig_cc := cc_default }

/- Memory accesses (load and store instructions) are annotated by
  a ``memory chunk'' indicating the type, size and signedness of the
  chunk of memory being accessed. -/

inductive memory_chunk : Type
| Mint8signed     /- 8-bit signed integer -/
| Mint8unsigned   /- 8-bit unsigned integer -/
| Mint16signed    /- 16-bit signed integer -/
| Mint16unsigned  /- 16-bit unsigned integer -/
| Mint32          /- 32-bit integer, or pointer -/
| Mint64          /- 64-bit integer -/
| Mfloat32        /- 32-bit single-precision float -/
| Mfloat64        /- 64-bit double-precision float -/
| Many32          /- any value that fits in 32 bits -/
| Many64          /- any value -/
open memory_chunk

instance chunk_eq : decidable_eq memory_chunk := by tactic.mk_dec_eq_instance

def Mptr : memory_chunk := if archi.ptr64 then Mint64 else Mint32.

/- The type (integer/pointer or float) of a chunk. -/

def memory_chunk.type : memory_chunk → typ
| Mint8signed    := Tint
| Mint8unsigned  := Tint
| Mint16signed   := Tint
| Mint16unsigned := Tint
| Mint32         := Tint
| Mint64         := Tlong
| Mfloat32       := Tsingle
| Mfloat64       := Tfloat
| Many32         := Tany32
| Many64         := Tany64

lemma memory_chunk.Mptr.type : Mptr.type = Tptr :=
by delta Mptr Tptr; cases archi.ptr64; refl

def chunk_of_type : typ → memory_chunk
| Tint    := Mint32
| Tfloat  := Mfloat64
| Tlong   := Mint64
| Tsingle := Mfloat32
| Tany32  := Many32
| Tany64  := Many64

lemma chunk_of_Tptr : chunk_of_type Tptr = Mptr :=
by delta Mptr Tptr; cases archi.ptr64; refl

/- * Properties of memory chunks -/

/- Memory reads and writes are performed by quantities called memory chunks,
  encoding the type, size and signedness of the chunk being addressed.
  The following functions extract the size information from a chunk. -/

def memory_chunk.size : memory_chunk → ℕ
| Mint8signed    := 1
| Mint8unsigned  := 1
| Mint16signed   := 2
| Mint16unsigned := 2
| Mint32         := 4
| Mint64         := 8
| Mfloat32       := 4
| Mfloat64       := 8
| Many32         := 4
| Many64         := 8

lemma memory_chunk.size_pos (chunk) : memory_chunk.size chunk > 0 :=
by cases chunk; exact dec_trivial

lemma memory_chunk.Mptr.size_eq : Mptr.size = if archi.ptr64 then 8 else 4 :=
by delta Mptr; cases archi.ptr64; refl

/- Memory reads and writes must respect alignment constraints:
  the byte offset of the location being addressed should be an exact
  multiple of the natural alignment for the chunk being addressed.
  This natural alignment is defined by the following
  [align_chunk] function.  Some target architectures
  (e.g. PowerPC and x86) have no alignment constraints, which we could
  reflect by taking [align_chunk chunk = 1].  However, other architectures
  have stronger alignment requirements.  The following definition is
  appropriate for PowerPC, ARM and x86. -/

def memory_chunk.align : memory_chunk → ℕ
| Mint8signed    := 1
| Mint8unsigned  := 1
| Mint16signed   := 2
| Mint16unsigned := 2
| Mint32         := 4
| Mint64         := 8
| Mfloat32       := 4
| Mfloat64       := 4
| Many32         := 4
| Many64         := 4

lemma memory_chunk.align_pos (chunk) : memory_chunk.align chunk > 0 :=
by cases chunk; exact dec_trivial

lemma memory_chunk.Mptr.align : Mptr.align = if archi.ptr64 then 8 else 4 :=
by delta Mptr; cases archi.ptr64; refl

lemma align_size_chunk_dvd (chunk : memory_chunk) : chunk.align ∣ chunk.size := sorry'

lemma align_le_dvd (chunk1 chunk2 : memory_chunk) (h : chunk1.align ≤ chunk2.align) :
  chunk1.align ∣ chunk2.align := sorry'

/- Initialization data for global variables. -/

inductive init_data : Type
| int8    : int32 → init_data
| int16   : int32 → init_data
| int32   : int32 → init_data
| int64   : int64 → init_data
| float32 : float32 → init_data
| float64 : float → init_data
| space   : ℕ → init_data
| addrof  : ident → ptrofs → init_data  /- address of symbol + offset -/

namespace init_data

def size : init_data → ℕ
| (int8 _)     := 1
| (int16 _)    := 2
| (int32 _)    := 4
| (int64 _)    := 8
| (float32 _)  := 4
| (float64 _)  := 8
| (addrof _ _) := if archi.ptr64 then 8 else 4
| (space n)    := n

def align : init_data → ℕ
| (int8 _)     := 1
| (int16 _)    := 2
| (int32 _)    := 4
| (int64 _)    := 8
| (float32 _)  := 4
| (float64 _)  := 4
| (addrof _ _) := if archi.ptr64 then 8 else 4
| (space _)    := 1

def list_size : list init_data → ℕ
| [] := 0
| (i :: il') := i.size + list_size il'

lemma size_pos (i : init_data) : i.size ≥ 0 := sorry'

lemma list_size_pos (il) : list_size il ≥ 0 := sorry'

def list_aligned : ℕ → list init_data → Prop
| p [] := true
| p (i1 :: il) := i1.align ∣ p ∧ list_aligned (p + i1.size) il

end init_data

/- Information attached to global variables. -/

structure globvar (V : Type) : Type :=
(info : V)                    /- language-dependent info, e.g. a type -/
(init : list init_data)       /- initialization data -/
(readonly : bool)             /- read-only variable? (const) -/
(volatile : bool)              /- volatile variable? -/

/- Whole programs consist of:
- a collection of global definitions (name and description);
- a set of public names (the names that are visible outside
  this compilation unit);
- the name of the ``main'' function that serves as entry point in the program.

A global definition is either a global function or a global variable.
The type of function descriptions and that of additional information
for variables vary among the various intermediate languages and are
taken as parameters to the [program] type.  The other parts of whole
programs are common to all languages. -/

inductive globdef (F V : Type) : Type
| Gfun {} (f : F) : globdef
| Gvar {} (v : globvar V) : globdef
export globdef

structure program (F V : Type) : Type :=
(defs : list (ident × globdef F V))
(public : list ident)
(main : ident)

def program.defs_names {F V : Type} (p : program F V) : list ident :=
p.defs.map prod.fst

/- The "definition map" of a program maps names of globals to their definitions.
  If several definitions have the same name, the one appearing last in [p.defs] wins. -/

section defmap

variables {F V : Type}
variable p : program F V

def prog_defmap : PTree (globdef F V) :=
PTree.of_list p.defs

lemma in_prog_defmap {id : ident} {g} : (prog_defmap p ^! id) = some g →
  (id, g) ∈ p.defs := sorry'

lemma prog_defmap_dom {id : ident} : id ∈ p.defs_names →
  ∃ g, (prog_defmap p^!id) = some g := sorry'

lemma prog_defmap_unique (defs1 id g defs2) :
  p.defs = defs1 ++ (id, g) :: defs2 →
  id ∉ defs2.map prod.fst →
  (prog_defmap p^!id) = some g := sorry'

lemma prog_defmap_nodup {id : ident} {g} :
  p.defs_names.nodup →
  (id, g) ∈ p.defs →
  (prog_defmap p ^! id) = some g := sorry'

end defmap

/- * Generic transformations over programs -/

/- We now define a general iterator over programs that applies a given
  code transformation function to all function descriptions and leaves
  the other parts of the program unchanged. -/

section transf_program

parameters {A B V : Type} (transf : A → B)

def transform_program_globdef : ident × globdef A V → ident × globdef B V
| (id, Gfun f) := (id, Gfun (transf f))
| (id, Gvar v) := (id, Gvar v)

def transform_program : program A V → program B V
| ⟨defs, pub, main⟩ := ⟨defs.map transform_program_globdef, pub, main⟩

end transf_program

/- The following is a more general presentation of [transform_program]:
- Global variable information can be transformed, in addition to function
  definitions.
- The transformation functions can fail and return an error message.
- The transformation for function definitions receives a global context
  (derived from the compilation unit being transformed) as additiona
  argument.
- The transformation functions receive the name of the global as
  additional argument. -/

section transf_program_gen

parameters {A B V W : Type}
parameter transf_fun : ident → A → res B.
parameter transf_var : ident → V → res W.

def transf_globvar (i : ident) : globvar V → res (globvar W)
| ⟨info, init, ro, vo⟩ := do info' ← transf_var i info, OK ⟨info', init, ro, vo⟩

def transf_globdefs : list (ident × globdef A V) → res (list (ident × globdef B W))
| [] := OK []
| ((id, Gfun f) :: l') :=
  match transf_fun id f with
  | error msg := error (MSG "In function " :: CTX id :: MSG ": " :: msg)
  | OK tf :=
      do tl' ← transf_globdefs l', OK ((id, Gfun tf) :: tl')
  end
| ((id, Gvar v) :: l') :=
  match transf_globvar id v with
  | error msg := error (MSG "In variable " :: CTX id :: MSG ": " :: msg)
  | OK tv :=
      do tl' ← transf_globdefs l', OK ((id, Gvar tv) :: tl')
  end

def transform_partial_program2 : program A V → res (program B W)
| ⟨defs, pub, main⟩ := do gl' ← transf_globdefs defs, OK ⟨gl', pub, main⟩

end transf_program_gen

/- The following is a special case of [transform_partial_program2],
  where only function definitions are transformed, but not variable definitions. -/

def transform_partial_program {A B V} (transf_fun : A → res B) : program A V → res (program B V) :=
transform_partial_program2 (λ i, transf_fun) (λ i, OK)

lemma transform_program_partial_program {A B V} (transf_fun : A → B) (p : program A V) :
  transform_partial_program (λ f, OK (transf_fun f)) p = OK (transform_program transf_fun p) := sorry'

/- * External functions -/

/- For most languages, the functions composing the program are either
  internal functions, defined within the language, or external functions,
  defined outside.  External functions include system calls but also
  compiler built-in functions.  We define a type for external functions
  and associated operations. -/

inductive external_function : Type
| EF_external (name : string) (sg : signature)
   /- A system call or library function.  Produces an event
       in the trace. -/
| EF_builtin (name : string) (sg : signature)
   /- A compiler built-in function.  Behaves like an external, but
       can be inlined by the compiler. -/
| EF_runtime (name : string) (sg : signature)
   /- A function from the run-time library.  Behaves like an
       external, but must not be redefined. -/
| EF_vload (chunk : memory_chunk)
   /- A volatile read operation.  If the adress given as first argument
       points within a volatile global variable, generate an
       event and return the value found in this event.  Otherwise,
       produce no event and behave like a regular memory load. -/
| EF_vstore (chunk : memory_chunk)
   /- A volatile store operation.   If the adress given as first argument
       points within a volatile global variable, generate an event.
       Otherwise, produce no event and behave like a regular memory store. -/
| EF_malloc
   /- Dynamic memory allocation.  Takes the requested size in bytes
       as argument; returns a pointer to a fresh block of the given size.
       Produces no observable event. -/
| EF_free
   /- Dynamic memory deallocation.  Takes a pointer to a block
       allocated by an [EF_malloc] external call and frees the
       corresponding block.
       Produces no observable event. -/
| EF_memcpy (sz al : ℕ)
   /- Block copy, of [sz] bytes, between addresses that are [al]-aligned. -/
| EF_annot (text : string) (targs : list typ)
   /- A programmer-supplied annotation.  Takes zero, one or several arguments,
       produces an event carrying the text and the values of these arguments,
       and returns no value. -/
| EF_annot_val (text : string) (targ : typ)
   /- Another form of annotation that takes one argument, produces
       an event carrying the text and the value of this argument,
       and returns the value of the argument. -/
| EF_inline_asm (text : string) (sg : signature) (clobbers : list string)
   /- Inline [asm] statements.  Semantically, treated like an
       annotation with no parameters ([EF_annot text nil]).  To be
       used with caution, as it can invalidate the semantic
       preservation theorem.  Generated only if [-finline-asm] is
       given. -/
| EF_debug (kind : pos_num) (text : ident) (targs : list typ)
   /- Transport debugging information from the front-end to the generated
       assembly.  Takes zero, one or several arguments like [EF_annot].
       Unlike [EF_annot], produces no observable event. -/
export external_function

/- The type signature of an external function. -/

def ef_sig : external_function → signature
| (EF_external name sg)        := sg
| (EF_builtin name sg)         := sg
| (EF_runtime name sg)         := sg
| (EF_vload chunk)             := ⟨[Tptr], some chunk.type, cc_default⟩
| (EF_vstore chunk)            := ⟨[Tptr, chunk.type], none, cc_default⟩
| (EF_malloc)                  := ⟨[Tptr], some Tptr, cc_default⟩
| (EF_free)                    := ⟨[Tptr], none, cc_default⟩
| (EF_memcpy sz al)            := ⟨[Tptr, Tptr], none, cc_default⟩
| (EF_annot text targs)        := ⟨targs, none, cc_default⟩
| (EF_annot_val text targ)     := ⟨[Tptr], some targ, cc_default⟩
| (EF_inline_asm text sg clob) := sg
| (EF_debug kind text targs)   := ⟨targs, none, cc_default⟩

/- Whether an external function should be inlined by the compiler. -/

def ef_inline : external_function → bool
| (EF_external name sg)        := ff
| (EF_builtin name sg)         := tt
| (EF_runtime name sg)         := ff
| (EF_vload chunk)             := tt
| (EF_vstore chunk)            := tt
| (EF_malloc)                  := ff
| (EF_free)                    := ff
| (EF_memcpy sz al)            := tt
| (EF_annot text targs)        := tt
| (EF_annot_val text targ)     := tt
| (EF_inline_asm text sg clob) := tt
| (EF_debug kind text targs)   := tt

/- Whether an external function must reload its arguments. -/

def ef_reloads : external_function → bool
| (EF_annot text targs)      := ff
| (EF_debug kind text targs) := ff
| _                          := tt

/- Equality between external functions.  Used in module [Allocation]. -/

instance external_function_eq : decidable_eq external_function := by tactic.mk_dec_eq_instance

/- Function definitions are the union of internal and external functions. -/

inductive fundef (F : Type) : Type
| Internal {} : F → fundef
| External {} : external_function → fundef
open fundef

section transf_fundef

parameters {A B : Type} (transf : A → B)

def transf_fundef : fundef A → fundef B
| (Internal f)  := Internal (transf f)
| (External ef) := External ef

end transf_fundef

section transf_partial_fundef

parameters {A B : Type} (transf_partial : A → res B)

def transf_partial_fundef : fundef A → res (fundef B)
| (Internal f)  := do f' ← transf_partial f, OK (Internal f')
| (External ef) := OK (External ef)

end transf_partial_fundef

/- * Register pairs -/

/- In some intermediate languages (LTL, Mach), 64-bit integers can be
  split into two 32-bit halves and held in a pair of registers.
  Syntactically, this is captured by the type [rpair] below. -/

inductive rpair (A : Type) : Type
| One (r : A) : rpair
| Twolong (rhi rlo : A) : rpair
open rpair

def typ_rpair {A} (typ_of : A → typ) : rpair A → typ
| (One r) := typ_of r
| (Twolong rhi rlo) := Tlong

def map_rpair {A B} (f : A → B) : rpair A → rpair B
| (One r) := One (f r)
| (Twolong rhi rlo) := Twolong (f rhi) (f rlo)

def regs_of_rpair {A} : rpair A → list A
| (One r) := [r]
| (Twolong rhi rlo) := [rhi, rlo]

def regs_of_rpairs {A} : list (rpair A) → list A
| [] := []
| (p :: l) := regs_of_rpair p ++ regs_of_rpairs l

lemma in_regs_of_rpair {A} (x : A) (p) (hm : x ∈ regs_of_rpair p) (l : list (rpair A)) (hp : p ∈ l) :
  x ∈ regs_of_rpairs l := sorry'

lemma in_regs_of_rpairs_inv {A} (x : A) (l : list (rpair A)) (hm : x ∈ regs_of_rpairs l) :
  ∃ p, p ∈ l ∧ x ∈ regs_of_rpair p := sorry'

def forall_rpair {A} (P : A → Prop) : rpair A → Prop
| (One r) := P r
| (Twolong rhi rlo) := P rhi ∧ P rlo

/- * Arguments and results to builtin functions -/

inductive builtin_arg (A : Type) : Type
| BA            {} (x : A)                                            : builtin_arg
| BA_int        {} (n : int32)                                        : builtin_arg
| BA_long       {} (n : int64)                                        : builtin_arg
| BA_float      {} (f : float)                                        : builtin_arg
| BA_single     {} (f : float32)                                      : builtin_arg
| BA_loadstack  {} (chunk : memory_chunk) (ofs : ptrofs)              : builtin_arg
| BA_addrstack  {} (ofs : ptrofs)                                     : builtin_arg
| BA_loadglobal {} (chunk : memory_chunk) (id : ident) (ofs : ptrofs) : builtin_arg
| BA_addrglobal {} (id : ident) (ofs : ptrofs)                        : builtin_arg
| BA_splitlong  {} (hi lo : builtin_arg)                              : builtin_arg
export builtin_arg

inductive builtin_res (A : Type) : Type
| BR           {} (x : A)               : builtin_res
| BR_none      {}                       : builtin_res
| BR_splitlong {} (hi lo : builtin_res) : builtin_res
open builtin_res

def globals_of_builtin_arg {A : Type} : builtin_arg A → list ident
| (BA_loadglobal chunk id ofs) := [id]
| (BA_addrglobal id ofs)       := [id]
| (BA_splitlong hi lo)         := globals_of_builtin_arg hi ++ globals_of_builtin_arg lo
| _ := []

def globals_of_builtin_args {A} (al : list (builtin_arg A)) : list ident :=
al.foldr (λ a l, globals_of_builtin_arg a ++ l) []

def params_of_builtin_arg {A} : builtin_arg A → list A
| (BA x) := [x]
| (BA_splitlong hi lo) := params_of_builtin_arg hi ++ params_of_builtin_arg lo
| _ := []

def params_of_builtin_args {A} (al : list (builtin_arg A)) : list A :=
al.foldr (λ a l, params_of_builtin_arg a ++ l) []

def params_of_builtin_res {A} : builtin_res A → list A
| (BR x)               := [x]
| BR_none              := []
| (BR_splitlong hi lo) := params_of_builtin_res hi ++ params_of_builtin_res lo

def map_builtin_arg {A B} (f : A → B) : builtin_arg A → builtin_arg B
| (BA x)                       := BA (f x)
| (BA_int n)                   := BA_int n
| (BA_long n)                  := BA_long n
| (BA_float n)                 := BA_float n
| (BA_single n)                := BA_single n
| (BA_loadstack chunk ofs)     := BA_loadstack chunk ofs
| (BA_addrstack ofs)           := BA_addrstack ofs
| (BA_loadglobal chunk id ofs) := BA_loadglobal chunk id ofs
| (BA_addrglobal id ofs)       := BA_addrglobal id ofs
| (BA_splitlong hi lo)         := BA_splitlong (map_builtin_arg hi) (map_builtin_arg lo)

def map_builtin_res {A B} (f : A → B) : builtin_res A → builtin_res B
| (BR x)               := BR (f x)
| BR_none              := BR_none
| (BR_splitlong hi lo) := BR_splitlong (map_builtin_res hi) (map_builtin_res lo)

/- Which kinds of builtin arguments are supported by which external function. -/

inductive builtin_arg_constraint : Type
| OK_default
| OK_const
| OK_addrstack
| OK_addrglobal
| OK_addrany
| OK_all
open builtin_arg_constraint

def builtin_arg_ok {A} : builtin_arg A → builtin_arg_constraint → bool
| (BA _)                       _             := tt
| (BA_splitlong (BA _) (BA _)) _             := tt
| (BA_int _)                   OK_const      := tt
| (BA_long _)                  OK_const      := tt
| (BA_float _)                 OK_const      := tt
| (BA_single _)                OK_const      := tt
| (BA_addrstack _)             OK_addrstack  := tt
| (BA_addrstack _)             OK_addrany    := tt
| (BA_addrglobal _ _)          OK_addrglobal := tt
| (BA_addrglobal _ _)          OK_addrany    := tt
| _                            OK_all        := tt
| _                            _             := ff

end ast


import unitb.models.nondet
import unitb.refinement.basic

namespace nondet

open temporal
open predicate
open unitb

universe variable u

section defs

variables {α β : Type}

structure evt_ref (lbl : Type) (mc : program α) (ea : event α) (ecs : lbl → event α) : Type :=
  (witness : lbl → α → Prop)
  (witness_fis : ⦃ ∃∃ e, witness e ⦄)
  (sim : ∀ ec, ⟦ (ecs ec).step_of ⟧ ⟹ ⟦ ea.step_of ⟧)
  (delay : ∀ ec, witness ec ⋀ ea.coarse_sch ⋀ ea.fine_sch ↦ witness ec ⋀ (ecs ec).coarse_sch in mc)
  (stable : ∀ ec, unless_except mc (witness ec ⋀ (ecs ec).coarse_sch) (-ea.coarse_sch) { e | ∃ l, ecs l = e })
  (resched : ∀ ec, ea.coarse_sch ⋀ ea.fine_sch ⋀ witness ec ↦ (ecs ec).fine_sch in mc)

structure refined (ma mc : program α) : Type :=
  (sim_init : mc^.first ⟹ ma^.first)
  (ref : option mc.lbl → option ma.lbl → Prop)
  (evt_sim : ∀ ec, ⟦ mc.step_of ec ⟧ ⟹ ∃∃ ea : { ea // ref ec ea }, ⟦ ma.step_of ea.val ⟧)
  (events : ∀ ae, evt_ref { ec // ref ec ae } mc (ma.event ae) (λ ec, mc.event ec.val) )

lemma refined.sim {ma mc : program α}
  (R : refined ma mc)
: ⟦ is_step mc ⟧ ⟹ ⟦ is_step ma ⟧ :=
begin
  simp [is_step_exists_event'],
  intro τ,
  intros H,
  cases H with ce H,
  apply exists_imp_exists' subtype.val _ (R.evt_sim ce τ H),
  intro, apply id,
end

end defs

section soundness

parameters {α β : Type}

parameter (ma : program α)
parameter (mc : program α)

open temporal

parameter R : refined ma mc
parameter τ : stream α
parameter M₁ : system_sem.ex mc τ

section schedules

parameter e : option ma.lbl
@[reducible]
def imp_lbl := { ec : option mc.lbl // R.ref ec e }

def AC := (program.event ma e).coarse_sch
def AF := (program.event ma e).fine_sch
def W (e' : imp_lbl) := (R.events e).witness e'
def CC (e' : option mc.lbl) := mc.coarse_sch_of e'
def CF (e' : option mc.lbl) := mc.fine_sch_of e'

parameter abs_coarse : (◇◻(•AC ⋀ -⟦ ma.step_of e ⟧)) τ

parameter abs_fine : (◻◇•AF) τ

include M₁
include abs_coarse
include abs_fine

lemma abs_coarse_and_fine
: (◻◇(•AC ⋀ •AF)) τ :=
begin
  apply coincidence,
  { apply stable_entails_stable _ _ abs_coarse,
    apply λ _, and.left },
  { apply abs_fine },
end

lemma conc_coarse : ∃ e', (◇◻(• W e' ⋀ • CC e'.val) ) τ :=
begin
  have H : ((∃∃ e', ◇◻(• W ma mc R e e' ⋀ • CC mc e'.val))
                   ⋁ ◻◇((-•AC ma e) ⋁ ∃∃ e' : imp_lbl ma mc R e, ⟦ mc.step_of e'.val ⟧)) τ,
  { rw exists_action,
    apply p_or_p_imp_p_or_right _ (unless_sem_exists' M₁.safety (R.events e).stable _),
    { apply inf_often_entails_inf_often,
      apply p_or_p_imp_p_or_right' _,
      apply action_entails_action,
      intros σ σ',
      simp [imp_lbl,mem_set_of],
      intros ec H x H' H₁,
      existsi x,
      cases H with H₀ H,
      cases H with H₂ STEP,
      unfold program.step_of,
      simp [H₂,event.step_of,STEP,H₀,H₁,H'], },
    have H' := leads_to.gen_disj' (R.events e).delay,
    apply inf_often_of_leads_to (system_sem.leads_to_sem H' _ M₁),
    simp,
    have H' := ew_eq_true (R.events e).witness_fis,
    rw [← p_and_over_p_exists_right
       ,← p_and_over_p_exists_right],
    simp [H'],
    apply abs_coarse_and_fine ma mc _ M₁ _ abs_coarse abs_fine, },
  simp at H,
  cases H with H H,
  { exfalso,
    revert abs_coarse,
    change ¬ _,
    rw [p_not_eq_not,not_eventually,not_henceforth,p_not_p_and,p_not_p_not_iff_self],
    apply inf_often_entails_inf_often _ _ H,
    apply p_or_p_imp_p_or_right',
    rw p_exists_entails_eq_p_forall_entails,
    intros ec,
    apply (R.events e).sim _ , },
  { simp [H], },
end

lemma conc_fine : ∀ e',
         (◇◻•W e') τ →
         (◻◇•CF e'.val) τ :=
begin
  intros e' H,
  have H' := system_sem.leads_to_sem ((R.events e).resched e') _ M₁,
  apply inf_often_of_leads_to H',
  rw p_and_comm,
  apply coincidence H,
  apply abs_coarse_and_fine _ _ _ M₁ _ abs_coarse abs_fine,
end

end schedules

include M₁
include R

theorem soundness : system_sem.ex ma τ :=
begin
  apply nondet.program.ex.mk,
  { apply R.sim_init,
    apply M₁.init },
  { intro i,
    apply R.sim,
    apply M₁.safety },
  { intros e COARSE₀ FINE₀,
    apply assume_neg _, intro ACT,
    have COARSE₁ :  (◇◻(•AC ma e ⋀ -⟦program.step_of ma e⟧)) τ,
    { rw [p_not_eq_not,not_henceforth,not_eventually] at ACT,
      apply stable_and_of_stable_of_stable COARSE₀ ACT },
    clear COARSE₀ ACT,
    cases conc_coarse ma mc R τ M₁ _ COARSE₁ FINE₀ with e' C_COARSE',
    have C_COARSE : (◇◻•CC mc e'.val) τ,
    { apply stable_entails_stable _ _ C_COARSE',
      intro, apply and.right },
    have WIT : (◇◻•W ma mc R e e') τ,
    { apply stable_entails_stable _ _ C_COARSE',
      intro, apply and.left },
    have C_FINE := conc_fine ma mc R τ M₁ e COARSE₁ FINE₀ e' WIT,
    apply inf_often_entails_inf_often _ _ (M₁.liveness _ C_COARSE C_FINE),
    have H := (R.events e).sim e',
    apply H, },
end

end soundness

end nondet


import Std.Tactic.GuardExpr
import Mathlib.Tactic.PermuteGoals

example (p q r : Prop) : p → q → r → p ∧ q ∧ r := by
  intros
  constructor
  on_goal 2 =>
    guard_target = q ∧ r
    constructor
    assumption
    -- Note that we have not closed all the subgoals here.
  guard_target = p
  assumption
  guard_target = r
  assumption

example (p q r : Prop) : p → q → r → p ∧ q ∧ r := by
  intros a b c
  constructor
  fail_if_success on_goal -3 => unreachable!
  fail_if_success on_goal -1 => exact a
  fail_if_success on_goal 0 => unreachable!
  fail_if_success on_goal 2 => exact a
  fail_if_success on_goal 3 => unreachable!
  on_goal 1 => exact a
  constructor
  swap
  exact c
  exact b

example (p q : Prop) : p → q → p ∧ q := by
  intros a b
  constructor
  fail_if_success pick_goal -3
  fail_if_success pick_goal 0
  fail_if_success pick_goal 3
  pick_goal -1
  exact b
  exact a

example (p : Prop) : p → p := by
  intros
  fail_if_success swap -- can't swap with a single goal
  assumption


def x := 1

#check x

variable {α : Type}

def f (a : α) : α :=
a

def tst (xs : List Nat) : Nat :=
xs.foldl (init := 10) (· + ·)

#check tst [1, 2, 3]

#check fun x y : Nat => x + y

#check tst

#check (fun stx => if True then let e := stx; Pure.pure e else Pure.pure stx : Nat → Id Nat)

#check let x : Nat := 1; x

def foo (a : Nat) (b : Nat := 10) (c : Bool := Bool.true) : Nat :=
a + b

set_option pp.all true

#check foo 1

#check foo 3 (c := false)

def Nat.boo (a : Nat) :=
succ a -- succ here is resolved as `Nat.succ`.

#check Nat.boo

#check true

-- apply is still a valid identifier name
def apply := "hello"

#check apply

theorem simple1 (x y : Nat) (h : x = y) : x = y :=
by {
  assumption
}

theorem simple2 (x y : Nat) : x = y → x = y :=
by {
  intro h;
  assumption
}

syntax "intro2" : tactic

macro_rules
| `(tactic| intro2) => `(tactic| intro; intro )

theorem simple3 (x y : Nat) : x = x → x = y → x = y :=
by {
  intro2;
  assumption
}

macro "intro3" : tactic => `(intro; intro; intro)
macro "check2" x:term : command => `(#check $x #check $x)
macro "foo" x:term "," y:term : term => `($x + $y + $x)

set_option pp.all false

check2 0+1
check2 foo 0,1

theorem simple4 (x y : Nat) : y = y → x = x → x = y → x = y :=
by {
  intro3;
  assumption
}

theorem simple5 (x y z : Nat) : y = z → x = x → x = y → x = z :=
by {
  intro h1; intro _; intro h3;
  exact Eq.trans h3 h1
}

theorem simple6 (x y z : Nat) : y = z → x = x → x = y → x = z :=
by {
  intro h1; intro _; intro h3;
  refine Eq.trans ?_ h1;
  assumption
}

theorem simple7 (x y z : Nat) : y = z → x = x → x = y → x = z :=
by {
  intro h1; intro _; intro h3;
  refine' Eq.trans ?pre ?post;
  exact y;
  { exact h3 }
  { exact h1 }
}

theorem simple8 (x y z : Nat) : y = z → x = x → x = y → x = z := by
intro h1; intro _; intro h3
refine' Eq.trans ?pre ?post
case post => exact h1
case pre => exact h3

theorem simple9 (x y z : Nat) : y = z → x = x → x = y → x = z := by
intros h1 _ h3
trace_state
focus
  refine' Eq.trans ?pre ?post
  first
    | exact h1
      assumption
    | exact y
      exact h3
      assumption

theorem simple9b (x y z : Nat) : y = z → x = x → x = y → x = z := by
intros h1 _ h3
trace_state
focus
  refine' Eq.trans ?pre ?post
  first
    | exact h1
    | exact y; exact h3
  assumption

theorem simple9c (x y z : Nat) : y = z → x = x → x = y → x = z := by
  intros h1 _ h3
  solve
    | exact h1
    | refine' Eq.trans ?pre ?post; exact y; exact h3; assumption
    | exact h3

theorem simple9d (x y z : Nat) : y = z → x = x → x = y → x = z := by
  intros h1 _ h3
  refine' Eq.trans ?pre ?post
  solve
    | exact h1
    | exact y
    | exact h3
  solve
    | exact h1
    | exact h3
  solve
    | exact h1
    | assumption

namespace Foo
  def Prod.mk := 1
  #check (⟨2, 3⟩ : Prod _ _)
end Foo

theorem simple10 (x y z : Nat) : y = z → x = x → x = y → x = z :=
by {
  intro h1; intro h2; intro h3;
  skip;
  apply Eq.trans;
  exact h3;
  assumption
}

theorem simple11 (x y z : Nat) : y = z → x = x → x = y → x = z :=
by {
  intro h1; intro h2; intro h3;
  apply @Eq.trans;
  trace_state;
  exact h3;
  assumption
}

theorem simple12 (x y z : Nat) : y = z → x = x → x = y → x = z :=
by {
  intro h1; intro h2; intro h3;
  apply @Eq.trans;
  try exact h1; -- `exact h1` fails
  trace_state;
  try exact h3;
  trace_state;
  try exact h1;
}

theorem simple13 (x y z : Nat) : y = z → x = x → x = y → x = z := by
intros h1 h2 h3
trace_state
apply @Eq.trans
case b => exact y
trace_state
repeat assumption

theorem simple13b (x y z : Nat) : y = z → x = x → x = y → x = z := by {
intros h1 h2 h3;
trace_state;
apply @Eq.trans;
case b => exact y;
trace_state;
repeat assumption
}

theorem simple14 (x y z : Nat) : y = z → x = x → x = y → x = z := by
intros
apply @Eq.trans
case b => exact y
repeat assumption

theorem simple15 (x y z : Nat) : y = z → x = x → x = y → x = z :=
by {
  intros h1 h2 h3;
  revert y;
  intros y h1 h3;
  apply Eq.trans;
  exact h3;
  exact h1
}

theorem simple16 (x y z : Nat) : y = z → x = x → x = y → x = z :=
by {
  intros h1 h2 h3;
  try clear x; -- should fail
  clear h2;
  trace_state;
  apply Eq.trans;
  exact h3;
  exact h1
}

macro "blabla" : tactic => `(assumption)

-- Tactic head symbols do not become reserved words
def blabla := 100

#check blabla

theorem simple17 (x : Nat) (h : x = 0) : x = 0 :=
by blabla

theorem simple18 (x : Nat) (h : x = 0) : x = 0 :=
by blabla

theorem simple19 (x y : Nat) (h₁ : x = 0) (h₂ : x = y) : y = 0 :=
by subst x; subst y; exact rfl

theorem tstprec1 (x y z : Nat) : x + y * z = x + (y * z) :=
rfl

theorem tstprec2 (x y z : Nat) : y * z + x = (y * z) + x :=
rfl

set_option pp.all true

#check fun {α} (a : α) => a
#check @(fun α (a : α) => a)

#check
  let myid := fun {α} (a : α) => a;
  myid [myid 1]

-- In the following example, we need `@` otherwise we will try to insert mvars for α and [Add α],
-- and will fail to generate instance for [Add α]
#check @(fun α (s : Add α) (a : α) => a + a)

def g1 {α} (a₁ a₂ : α) {β} (b : β) : α × α × β :=
(a₁, a₂, b)

def id1 : {α : Type} → α → α :=
fun x => x

def listId : List ({α : Type} → α → α) :=
(fun x => x) :: []

def id2 : {α : Type} → α → α :=
@(fun α (x : α) => id1 x)

def id3 : {α : Type} → α → α :=
@(fun α x => id1 x)

def id4 : {α : Type} → α → α :=
fun x => id1 x

def id5 : {α : Type} → α → α :=
fun {α} x => id1 x

def id6 : {α : Type} → α → α :=
@(fun {α} x => id1 x)

def id7 : {α : Type} → α → α :=
fun {α} x => @id α x

def id8 : {α : Type} → α → α :=
fun {α} x => id (@id α x)

def altTst1 {m σ} [Alternative m] [Monad m] : Alternative (StateT σ m) :=
⟨StateT.failure, StateT.orElse⟩

def altTst2 {m σ} [Alternative m] [Monad m] : Alternative (StateT σ m) :=
⟨@(fun α => StateT.failure), @(fun α => StateT.orElse)⟩

def altTst3 {m σ} [Alternative m] [Monad m] : Alternative (StateT σ m) :=
⟨fun {α} => StateT.failure, fun {α} => StateT.orElse⟩

#check_failure 1 + true

/-
universe u v

/-
  MonadFunctorT.{u ?M_1 v} (λ (β : Type u), m α) (λ (β : Type u), m' α) n n'
-/
set_option pp.raw.maxDepth 100
set_option trace.Elab true

def adapt {m m' σ σ'} {n n' : Type → Type} [MonadFunctor m m' n n'] [MonadStateAdapter σ σ' m m'] : MonadStateAdapter σ σ' n n' :=
⟨fun split join => monadMap (adaptState split join : m α → m' α)⟩

-/

syntax "fn" (term:max)+ "=>" term : term

macro_rules
| `(fn $xs* => $b) => `(fun $xs* => $b)

set_option pp.all false

#check fn x => x+1

#check fn α (a : α) => a

def tst1 : {α : Type} → α → α :=
@(fn α a => a)

#check @tst1

syntax ident "==>" term : term

syntax "{" ident "}" "==>" term : term

macro_rules
| `($x:ident ==> $b)   => `(fn $x => $b)
| `({$x:ident} ==> $b) => `(fun {$x:ident} => $b)

#check x ==> x+1

def tst2a : {α : Type} → α → α :=
@(α ==> a ==> a)

def tst2b : {α : Type} → α → α :=
{α} ==> a ==> a

#check @tst2a
#check @tst2b

def tst3a : {α : Type} → {β : Type} → α → β → α × β :=
@(α ==> @(β ==> a ==> b ==> (a, b)))

def tst3b : {α : Type} → {β : Type} → α → β → α × β :=
{α} ==> {β} ==> a ==> b ==> (a, b)

syntax "function" (term:max)+ "=>" term : term

macro_rules
| `(function $xs* => $b) => `(@(fun $xs* => $b))

def tst4 : {α : Type} → {β : Type} → α → β → α × β :=
function α β a b => (a, b)

theorem simple20 (x y z : Nat) : y = z → x = x → x = y → x = z :=
by intros h1 h2 h3;
   try clear x; -- should fail
   clear h2;
   trace_state;
   apply Eq.trans;
   exact h3;
   exact h1

theorem simple21 (x y z : Nat) : y = z → x = x → y = x → x = z :=
fun h1 _ h3 =>
  have : x = y := by { apply Eq.symm; assumption };
  Eq.trans this (by assumption)

theorem simple22 (x y z : Nat) : y = z → y = x → id (x = z + 0) :=
fun h1 h2 => show x = z + 0 by
  apply Eq.trans
  exact h2.symm
  assumption
  skip

theorem simple23 (x y z : Nat) : y = z → x = x → y = x → x = z :=
fun h1 _ h3 =>
  have : x = y := by apply Eq.symm; assumption
  Eq.trans this (by assumption)

theorem simple24 (x y z : Nat) : y = z → x = x → y = x → x = z :=
fun h1 _ h3 =>
  have h : x = y := by apply Eq.symm; assumption
  Eq.trans h (by assumption)

def f1 (x : Nat) : Nat :=
  let double x := x + x
  let rec loop x :=
    match x with
    | 0   => 0
    | x+1 => loop x + double x
  loop x

#eval f1 5

def f2 (x : Nat) : String :=
  let bad x : String := toString x
  bad x

def f3 x y :=
  x + y + 1

theorem f3eq x y : f3 x y = x + y + 1 :=
  rfl

def f4 (x y : Nat) : String :=
  if x > y + 1 then "hello" else "world"


import .aff1K
import category_theory.groupoid
import linear_algebra.affine_space.affine_equiv
import linear_algebra.matrix

/-
Framed points, vectors, frames
-/

open_locale affine
universes u

section explicitK

variables
(K : Type u) [field K] [inhabited K]

/-
Is this where we root distinctions between affine spaces for different dimensionss?
-/
inductive fm : nat → Type u
| base : Π n, fm n
| deriv : Π n, (prod (pt K) (vec K)) → fm n → fm n  -- TODO: curry all of these args

/-
inductive fm : nat → Type u
| base : ∀ (n : nat), fm n
| deriv : ∀ (n : nat), (prod (pt K) (vec K)) → fm n → fm n
-/

def mk_fm  {n : nat} (p : pt K) (v : vec K) (f : fm K n): fm K n := fm.deriv n (p, v) f

structure spc {n : nat} (f : fm K n) : Type u       -- interesting specimen, here, btw

def mk_space {n : nat} (f : fm K n) :=
  @spc.mk K _ _ n f

end explicitK

section implicitK

variables
{K : Type u} [field K] [inhabited K]
{n : nat} {f : fm K n} (s : spc K f)

/-
Augment pt and vec types with spaces and frames and
then make operations apply only for objects in same
space (and thus frame).
-/
@[ext]
structure point {f : fm K n} (s : @spc K _ _ n f ) extends pt K
@[simp]
def mk_point' (p : pt K) : point s := point.mk p
@[simp]
def mk_point (k : K) : point s := point.mk (mk_pt K k)

def p := mk_point s (3:K)

@[ext]
structure vectr {f : fm K n} (s : spc K f ) extends vec K
@[simp]
def mk_vectr' (v : vec K) : vectr s := vectr.mk v
@[simp]
def mk_vectr (k : K) : vectr s := vectr.mk (mk_vec K k)

-- note that we don't extend fm
def mk_frame {parent : fm K n} {s : spc K parent}  (p : point s) (v : vectr s) :=
fm.deriv n (p.to_pt, v.to_vec) parent   -- TODO: make sure v ≠ 0 (erasing tyoe info)
                                        -- TODO: snd arg is really a basis for the vs

/-
    *************************************
    Instantiate module K (vector K)
    *************************************
-/

variables v1 v2 : @vectr K _ _ n f s
#check v1.to_vec
#check v2.to_vec + v1.to_vec

@[simp]
def add_vectr_vectr (v1 v2 : vectr s) : vectr s :=  mk_vectr' s (v1.to_vec + v2.to_vec)
@[simp]
def smul_vectr (k : K) (v : vectr s) : vectr s := mk_vectr' s (k • v.to_vec)
@[simp]
def neg_vectr (v : vectr s) : vectr s := mk_vectr' s ((-1 : K) • v.to_vec)
@[simp]
def sub_vectr_vectr (v1 v2 : vectr s) : vectr s := add_vectr_vectr s v1 (neg_vectr s v2)

-- See unframed file for template for proving module

instance has_add_vectr : has_add (vectr s) := ⟨add_vectr_vectr s⟩
lemma add_assoc_vectr : ∀ a b c : vectr s, a + b + c = a + (b + c) :=
begin
    intros,
    ext,
    --cases a,
    repeat {
    have p1 : (a + b + c).to_vec = a.to_vec + b.to_vec + c.to_vec := rfl,
    have p2 : (a + (b + c)).to_vec = a.to_vec + (b.to_vec + c.to_vec) := rfl,
    rw [p1,p2],
    cc
    }
end

instance add_semigroup_vectr : add_semigroup (vectr s) := ⟨ add_vectr_vectr s, add_assoc_vectr s⟩

@[simp]
def vectr_zero := @mk_vectr K _ _ n f s (0:K)
instance has_zero_vectr : has_zero (vectr s) := ⟨vectr_zero s⟩

#check mul_zero_class.zero

lemma zero_add_vectr : ∀ a : vectr s, 0 + a = a :=
begin
    intros,--ext,
    ext,
    let h0 : (0 + a).to_vec = (0 : vectr s).to_vec + a.to_vec := rfl,
    simp [h0],
    exact zero_add _,
end

lemma add_zero_vectr : ∀ a : vectr s, a + 0 = a :=
begin
    intros,ext,
    exact add_zero _,
end

@[simp]
def nsmul_vectr : ℕ → (vectr s) → (vectr s)
| nat.zero v := vectr_zero s
--| 1 v := v
| (nat.succ n) v := (add_vectr_vectr _) v (nsmul_vectr n v)

instance add_monoid_vectr : add_monoid (vectr s) := ⟨
    -- add_semigroup
    add_vectr_vectr s,
    add_assoc_vectr s,
    -- has_zero
    vectr_zero s,
    -- new structure
    zero_add_vectr s,
    add_zero_vectr s,
    nsmul_vectr s
⟩

instance has_neg_vectr : has_neg (vectr s) := ⟨ neg_vectr s ⟩
instance has_sub_vectr : has_sub (vectr s) := ⟨ sub_vectr_vectr s ⟩
lemma sub_eq_add_neg_vectr : ∀ a b : vectr s, a - b = a + -b :=
begin
    intros,ext,
    refl,

end

instance sub_neg_monoid_vectr : sub_neg_monoid (vectr s) :=
{
    neg := neg_vectr s,
    ..(show add_monoid (vectr s), by apply_instance)
}

/- ⟨
    add_vectr_vectr s, add_assoc_vectr s, vectr_zero s, zero_add_vectr s, add_zero_vectr s, -- add_monoid
    neg_vectr s,                                                                  -- has_neg
    sub_vectr_vectr s,                                                              -- has_sub
    sub_eq_add_neg_vectr s,                                                       -- new
⟩ -/

lemma add_left_neg_vectr : ∀ a : vectr s, -a + a = 0 :=
begin
    intros,
    ext,
    have h0 : (-a + a).to_vec = -a.to_vec + a.to_vec := begin
        have h₁ : -a + a = add_vectr_vectr _ (-a) a := rfl,
        rw h₁,
        dsimp only [add_vectr_vectr],
        dsimp only [mk_vectr'],
        have h₂ : -a = neg_vectr _ a := rfl,
        rw h₂,
        dsimp only [neg_vectr, mk_vectr'],
        suffices h : (-(1 : K)) • a.to_vec = -a.to_vec,
        rw h,
        simp only [one_smul, neg_smul],
    end,
    simp [h0],
    have : (0:vec K) = (0:vectr s).to_vec := rfl,
    simp *,
end

instance : add_group (vectr s) := {
    add_left_neg := begin
        exact add_left_neg_vectr s,
    end,
..(show sub_neg_monoid (vectr s), by apply_instance),

}

/-⟨
    -- sub_neg_monoid
    add_vectr_vectr s, add_assoc_vectr s, vectr_zero s, zero_add_vectr s, add_zero_vectr s, -- add_monoid
    neg_vectr s,                                                                  -- has_neg
    sub_vectr_vectr s,                                                              -- has_sub
    sub_eq_add_neg_vectr s,
    -- new
    add_left_neg_vectr s,
⟩ -/

lemma add_comm_vectr : ∀ a b : vectr s, a + b = b + a :=
begin
    intros,
    ext,
    repeat {
    have p1 : (a + b).to_vec = a.to_vec + b.to_vec:= rfl,
    have p2 : (b + a).to_vec = b.to_vec + a.to_vec := rfl,
    rw [p1,p2],
    cc
    }
end

instance add_comm_semigroup_vectr : add_comm_semigroup (vectr s) := ⟨
    -- add_semigroup
    add_vectr_vectr s,
    add_assoc_vectr s,
    add_comm_vectr s,
⟩

instance add_comm_monoid_vectr : add_comm_monoid (vectr s) :=
{
    add_comm := begin
        exact add_comm_vectr s
    end,
    ..(show add_monoid (vectr s), by apply_instance)
}

instance has_scalar_vectr : has_scalar K (vectr s) := ⟨
smul_vectr s,
⟩

lemma one_smul_vectr : ∀ b : vectr s, (1 : K) • b = b := begin
    intros,ext,
    repeat {
        have h0 : ((1:K) • b).to_vec = ((1:K)•(b.to_vec)) := rfl,
        rw [h0],
        simp *,
    }
end

lemma mul_smul_vectr : ∀ (x y : K) (b : vectr s), (x * y) • b = x • y • b :=
begin
    intros,
    cases b,
    ext,
    exact mul_assoc x y _,
end

instance mul_action_vectr : mul_action K (vectr s) := ⟨
one_smul_vectr s,
mul_smul_vectr s,
⟩

lemma smul_add_vectr : ∀(r : K) (x y : vectr s), r • (x + y) = r • x + r • y := begin
    intros, ext,
    repeat {
    have h0 : (r • (x + y)).to_vec = (r • (x.to_vec + y.to_vec)) := rfl,
    have h1 : (r•x + r•y).to_vec = (r•x.to_vec + r•y.to_vec) := rfl,
    rw [h0,h1],
    simp *,
    }

end

lemma smul_zero_vectr : ∀(r : K), r • (0 : vectr s) = 0 := begin
    intros, ext, exact mul_zero _
end
instance distrib_mul_action_K_vectrK : distrib_mul_action K (vectr s) := ⟨
smul_add_vectr s,
smul_zero_vectr s,
⟩

-- renaming vs template due to clash with name "s" for prevailing variable
lemma add_smul_vectr : ∀ (a b : K) (x : vectr s), (a + b) • x = a • x + b • x :=
begin
  intros,
  ext,
  exact right_distrib _ _ _
end

lemma zero_smul_vectr : ∀ (x : vectr s), (0 : K) • x = 0 := begin
    intros,
    ext,
    exact zero_mul _,
end
instance module_K_vectrK : module K (vectr s) := ⟨
    add_smul_vectr s,
    zero_smul_vectr s,
⟩

instance add_comm_group_vectr : add_comm_group (vectr s) :=
{
    add_comm := begin
        exact add_comm_vectr s

        /-intros,
        ext,
        let h0 : (a + b).to_vec = a.to_vec + b.to_vec := rfl,
        let h1 : (b + a).to_vec = b.to_vec + a.to_vec := rfl,
        rw [h0,h1],
        exact add_comm _ _,
        exact add_comm _ _,-/
    end,
--to_add_group := (show add_group (vec K), by apply_instance),
--to_add_comm_monoid := (show add_comm_monoid (vec K), by apply_instance),
..(show add_group (vectr s), by apply_instance)
}
/-⟨
-- add_group
    add_vectr_vectr s, add_assoc_vectr s, vectr_zero s, zero_add_vectr s, add_zero_vectr s, -- add_monoid
    neg_vectr s,                                                                  -- has_neg
    sub_vectr_vectr s,                                                              -- has_sub
    sub_eq_add_neg_vectr s,
    add_left_neg_vectr s,
-- commutativity
    add_comm_vectr s,
⟩-/

instance : module K (vectr s) := module_K_vectrK s

/-
    ********************
    *** Affine space ***
    ********************
-/

/-
Affine operations
-/
instance : has_add (vectr s) := ⟨add_vectr_vectr s⟩
instance : has_zero (vectr s) := ⟨vectr_zero s⟩
instance : has_neg (vectr s) := ⟨neg_vectr s⟩

/-
Lemmas needed to implement affine space API
-/
@[simp]
def sub_point_point (p1 p2 : point s) : vectr s := mk_vectr' s (p1.to_pt -ᵥ p2.to_pt)
@[simp]
def add_point_vectr {f : fm K n} {s : spc K f } (p : point s) (v : vectr s) : point s :=
    mk_point' s (v.to_vec +ᵥ p.to_pt) -- reorder assumes order is irrelevant
@[simp]
def add_vectr_point {f : fm K n} {s : spc K f } (v : vectr s) (p : point s) : point s :=
    mk_point' s (v.to_vec +ᵥ p.to_pt)

@[simp]
def aff_vectr_group_action : vectr s → point s → point s := add_vectr_point
instance : has_vadd (vectr s) (point s) := ⟨aff_vectr_group_action s⟩

lemma zero_vectr_vadd'_a1 : ∀ p : point s, (0 : vectr s) +ᵥ p = p := begin
    intros,
    ext,--exact zero_add _,
    exact add_zero _
end

lemma vectr_add_assoc'_a1 : ∀ (g1 g2 : vectr s) (p : point s), g1 +ᵥ (g2 +ᵥ p) = g1 + g2 +ᵥ p := begin
    intros, ext,
    repeat {
    have h0 : (g1 +ᵥ (g2 +ᵥ p)).to_pt = (g1.to_vec +ᵥ (g2.to_vec +ᵥ p.to_pt)) := rfl,
    have h1 : (g1 + g2 +ᵥ p).to_pt = (g1.to_vec +ᵥ g2.to_vec +ᵥ p.to_pt) := rfl,
    rw [h0,h1],
    simp *,
    simp [has_vadd.vadd, has_add.add, add_semigroup.add, add_zero_class.add,  add_monoid.add, sub_neg_monoid.add,
        add_group.add, distrib.add, ring.add, division_ring.add],
    cc,
    }
end

instance vectr_add_action: add_action (vectr s) (point s) :=
⟨
begin
    exact zero_vectr_vadd'_a1 s
end,
begin
    let h0 := vectr_add_assoc'_a1 s,
    intros,
    exact (h0 g₁ g₂ p).symm
end
⟩

@[simp]
def aff_point_group_sub : point s → point s → vectr s := sub_point_point s
instance point_has_vsub : has_vsub (vectr s) (point s) := ⟨ aff_point_group_sub s ⟩

instance : nonempty (point s) := ⟨mk_point s 0⟩

lemma point_vsub_vadd_a1 : ∀ (p1 p2 : (point s)), (p1 -ᵥ p2) +ᵥ p2 = p1 := begin
    intros, ext,
    --repeat {
    have h0 : (p1 -ᵥ p2 +ᵥ p2).to_pt = (p1.to_pt -ᵥ p2.to_pt +ᵥ p2.to_pt) := rfl,
    rw h0,
    simp [has_vsub.vsub, has_sub.sub, sub_neg_monoid.sub, add_group.sub, add_comm_group.sub, ring.sub, division_ring.sub],
    simp [has_vadd.vadd, has_add.add, distrib.add, ring.add, division_ring.add],
    let h0 : field.add p2.to_pt.to_prod.fst (field.sub p1.to_pt.to_prod.fst p2.to_pt.to_prod.fst) =
            field.add (field.sub p1.to_pt.to_prod.fst p2.to_pt.to_prod.fst) p2.to_pt.to_prod.fst := add_comm _ _,
    rw h0,
    exact sub_add_cancel _ _,
    have h0 : (p1 -ᵥ p2 +ᵥ p2).to_pt = (p1.to_pt -ᵥ p2.to_pt +ᵥ p2.to_pt) := rfl,
    rw h0,
    simp [has_vsub.vsub, has_sub.sub, sub_neg_monoid.sub, add_group.sub, add_comm_group.sub, ring.sub, division_ring.sub],
    simp [has_vadd.vadd, has_add.add, distrib.add, ring.add, division_ring.add],
    let h0 : field.add p2.to_pt.to_prod.snd (field.sub p1.to_pt.to_prod.snd p2.to_pt.to_prod.snd) =
            field.add (field.sub p1.to_pt.to_prod.snd p2.to_pt.to_prod.snd) p2.to_pt.to_prod.snd := add_comm _ _,
    rw h0,
    exact sub_add_cancel _ _,
    --have h1 : (p1.to_pt -ᵥ p2.to_pt +ᵥ p2.to_pt).to_prod = (p1.to_pt.to_prod -ᵥ p2.to_pt.to_prod +ᵥ p2.to_pt.to_prod) := by simp *,

    --}
end

lemma point_vadd_vsub_a1 : ∀ (g : vectr s) (p : point s), g +ᵥ p -ᵥ p = g :=
begin
    intros, ext,
    repeat {
    have h0 : ((g +ᵥ p -ᵥ p) : vectr s).to_vec = (g.to_vec +ᵥ p.to_pt -ᵥ p.to_pt) := rfl,
    rw h0,
    simp *,
    }
end

/-instance aff_point_torsor : add_torsor (vectr s) (point s) :=
⟨
    aff_vectr_group_action s,
    zero_vectr_vadd'_a1 s,    -- from add_action
    vectr_add_assoc'_a1 s,    -- from add_action
    aff_point_group_sub s,    -- from has_vsub
    point_vsub_vadd_a1 s,     -- from add_torsor
    point_vadd_vsub_a1 s,     -- from add_torsor
⟩-/

instance : affine_space (vectr s) (point s) := ⟨
    begin
        exact point_vsub_vadd_a1 s,
    end,
    begin
        exact point_vadd_vsub_a1 s,
    end,

⟩

/-
And now for transforms
-/

--variables {f1 : fm K n} {f2 : fm K n} (s1 : spc K f1) (s2 : spc K f2)
#check (point s) ≃ᵃ[K] (point s)
--not usable?
abbreviation raw_tr := (pt K) ≃ᵃ[K] (pt K)
--abbreviation fm_tr := (point s1) ≃ᵃ[K] (point s2)

@[ext]
structure fm_tr {f1 : fm K n} {f2 : fm K n} (s1 : spc K f1) (s2 : spc K f2)  extends (point s1) ≃ᵃ[K] (point s2)

def fm_tr.refl {f1 : fm K n} (s1 : spc K f1) : fm_tr s1 s1 :=
    ⟨⟨
        equiv.refl (point s1),
        linear_equiv.refl K (vectr s1),
        λ _ _, rfl
    ⟩⟩

def fm_tr.symm  {f1 : fm K n} {f2 : fm K n} {s1 : spc K f1} {s2 : spc K f2} (ftr : fm_tr s1 s2) : fm_tr s2 s1 :=
    ⟨ftr.1.symm⟩

def fm_tr.trans  {f1 : fm K n} {f2 : fm K n} {f3 : fm K n} {s1 : spc K f1} {s2 : spc K f2} {s3 : spc K f3} (ftr : fm_tr s1 s2) : fm_tr s2 s3 → fm_tr s1 s3 :=
    λftr_, ⟨ftr.1.trans ftr_.1⟩

#check (fin 2)
/-
inductive fm : nat → Type u
| base : Π n, fm n
| deriv : Π n, (prod (pt K) (vec K)) → fm n → fm n
-/
/-
@[simp]
def fm.to_coords_matrix (f : fm K n) : matrix (fin 2) (fin 2) K
    :=
    match f with
    | (fm.base n) := λ i j,
        if i = 0 ∧ j = 0 then 1 else
        (if i = 0 ∧ j = 1 then 0 else (
            if i = 1 ∧ j = 0 then 0 else
                (if i = 1 ∧ j = 1 then 1 else 0)
        ))
    | (fm.deriv n c parent) := λ i j,
        if i = 0 ∧ j = 0 then c. else
        (if i = 0 ∧ j = 1 then 0 else (
            if i = 1 ∧ j = 0 then 0 else
                (if i = 1 ∧ j = 1 then 1 else 0)
        ))
    end
-/

/-
TODO: This material needs inspection, verification
-/
#check @function.left_inverse
def to_base_helper' : fm K n → @raw_tr K _ _
| (fm.base n) := ⟨
            ⟨   /-base case -/
                (λ p, p),
                (λ p, p),
                begin
                    unfold function.left_inverse,
                    intros,
                    simp *
                end,
                begin
                    unfold function.right_inverse function.left_inverse,
                    intros,
                    simp *
                end
            ⟩,
            ⟨
                (λ v, v),
                begin
                    intros, simp*
                end,
               -- (λ v, ⟨v.to_vec⟩),
                begin
                    intros, simp *
                end,
                (λ v, v),
                begin
                    unfold function.left_inverse,
                    intros, simp *
                end,
                begin
                    unfold function.left_inverse function.right_inverse,
                    intros, simp *
                end,
            ⟩,
            begin
                simp *,
                --admit   -- TODO: What's this?
            end
        ⟩
| (fm.deriv n c parent) := (⟨
            ⟨/-transform from current->parent-/
                λp, ⟨(1,
                        p.to_prod.2*c.snd.to_prod.2 + c.fst.to_prod.2),
                        begin
                            cases p,

                        end⟩,
                    λp, (⟨(1,
                        (p.to_prod.2 - c.fst.to_prod.2 )/c.snd.to_prod.2),sorry⟩),
                sorry,
                sorry
            ⟩,
            ⟨
                λv, ⟨(0, v.to_prod.2*c.snd.to_prod.2),begin
                    cases v,
                    simp *,
                end⟩,
                sorry,
                sorry,
                λv, ⟨(0, v.to_prod.2/c.snd.to_prod.2),begin
                    cases v,
                    simp *,
                end⟩,
                sorry,
                sorry
            ⟩,
            sorry /-invert to parent->current and append to current->base-/
        ⟩ : @raw_tr K _ _).trans (to_base_helper' parent)

def spc.to_base {f1 : fm K n} (s1 : spc K f1) : @raw_tr K _ _ := to_base_helper' f1

def spc.fm_tr {f1 : fm K n} {f2 : fm K n} (s1 : spc K f1) : Π (s2 : spc K f2),
    fm_tr s1 s2
    :=
     --(point s1) ≃ᵃ[K] (point s2) :=
    λ s2,
    ⟨
    let rawtr : @raw_tr K _ _ := s1.to_base.trans s2.to_base.symm in
                ⟨
            ⟨
                (λ p : point _, (⟨(rawtr p.1 : pt K)⟩ : point _)),
                (λ p : point _, (⟨(rawtr p.1 : pt K)⟩ : point _)),
                sorry,
                sorry
            ⟩,
            ⟨
                (λv : vectr _, (⟨(rawtr.linear v.1 : vec K)⟩ : vectr _)),
                sorry,
               -- (λ v, ⟨v.to_vec⟩),
                sorry,
                (λv : vectr _, (⟨(rawtr.linear v.1 : vec K)⟩ : vectr _)),
                sorry,
                sorry
            ⟩,
            sorry
        ⟩
    ⟩

def fm_tr.transform_point  {f1 : fm K n} {f2 : fm K n} {s1 : spc K f1} {s2 : spc K f2} (tr:fm_tr s1 s2 ) : point s1 → point s2 :=
    λp,
    tr.to_equiv p

def fm_tr.transform_vectr  {f1 : fm K n} {f2 : fm K n} {s1 : spc K f1} {s2 : spc K f2} (tr:fm_tr s1 s2 ) : vectr s1 → vectr s2 :=
    λv,
    let as_pt : point s1 := (⟨⟨(1,v.to_vec.to_prod.2),rfl⟩⟩) in
    let tr_pt := (tr.to_equiv as_pt) in
    ⟨⟨(0, tr_pt.to_pt.to_prod.2),rfl⟩⟩

/-
DEMO: transform generation between arbitrary affine coordinate spaces on physical dimension
-/
variables {f1 : fm K n} {f2 : fm K n} (s1 : spc K f1) (s2 : spc K f2)

def s1_to_s2 : _ := s1.fm_tr s2     -- Yay!

#check s1_to_s2 s1 s2

variables (my_vec : vectr s1)

#check ((s1_to_s2 s1 s2).transform_vectr) (((s1_to_s2 s1 s2).transform_vectr) my_vec)

instance : quiver (spc K f) := ⟨λ (s1 s2 : spc K f), fm_tr s1 s2⟩

instance : category_theory.category_struct (spc K f) := ⟨
    λ (s : spc K f), fm_tr.refl s, -- identity transformation
    λ {s1 s2 s3 : spc K f} (f : fm_tr s1 s2) (g : fm_tr s2 s3), fm_tr.trans f g -- f ∘ g
⟩

instance : category_theory.category (spc K f) := ⟨
    begin
        simp only [auto_param_eq],
        intros,
        have h_orig := (fm_tr.ext_iff (𝟙 X ≫ f_1) f_1).2,
        apply h_orig,
        cases f_1 with f_aff,
        cases f_aff with f_equiv f_linear f_map_vadd',
        dsimp only [category_theory.category_struct.id, fm_tr.refl],
        dsimp only [category_theory.category_struct.comp, fm_tr.trans, affine_equiv.trans],
        ext,
        dsimp only [coe_fn, has_coe_to_fun.coe],
        simp only [equiv.refl_trans],
    end,
    begin
        simp only [auto_param_eq],
        intros,
        have h₀ := (fm_tr.ext_iff (𝟙 X ≫ f_1) f_1).2,
        apply h₀,
        cases f_1 with f_aff,
        cases f_aff with f_equiv f_linear f_map_vadd',
        dsimp only [category_theory.category_struct.id, fm_tr.refl],
        dsimp only [category_theory.category_struct.comp, fm_tr.trans, affine_equiv.trans],
        ext,
        dsimp only [coe_fn, has_coe_to_fun.coe],
        simp only [equiv.refl_trans],
    end,
    begin
        simp only [auto_param_eq],
        intros,
        have h₀ := (fm_tr.ext_iff ((f_1 ≫ g) ≫ h) (f_1 ≫ g ≫ h)).2,
        apply h₀,
        cases f_1 with f_aff,
        cases g with g_aff,
        cases h with h_aff,
        cases f_aff with f_equiv f_linear f_map_vadd',
        cases g_aff with g_equiv g_linear g_map_vadd',
        cases h_aff with h_equiv h_linear h_map_vadd',
        dsimp only [category_theory.category_struct.comp, fm_tr.trans, affine_equiv.trans],
        ext,
        dsimp only [coe_fn, has_coe_to_fun.coe],
        simp only [equiv.trans_assoc],
    end
⟩

instance : category_theory.groupoid (spc K f) := ⟨
    λ {s1 s2 : spc K f} (f_1 : fm_tr s1 s2), fm_tr.symm f_1,
    begin
        simp only [auto_param_eq],
        intros,
        dsimp only [category_theory.category_struct.comp],
        have h₀ := (fm_tr.ext_iff ((fm_tr.symm f_1).trans f_1) (𝟙 Y)).2,
        apply h₀,
        dsimp only [category_theory.category_struct.id, fm_tr.refl],
        dsimp only [fm_tr.trans, affine_equiv.trans],
        dsimp only [fm_tr.symm, affine_equiv.symm],
        ext,
        dsimp only [coe_fn, has_coe_to_fun.coe],
        simp only [affine_equiv.coe_to_equiv, equiv.to_fun_as_coe, id.def, function.comp_app, affine_equiv.apply_symm_apply,
            equiv.coe_trans, affine_equiv.symm_to_equiv, equiv.coe_refl],
    end,
    begin
        simp only [auto_param_eq],
        intros,
        dsimp only [category_theory.category_struct.comp],
        have h₀ := (fm_tr.ext_iff (fm_tr.trans f_1 (fm_tr.symm f_1)) (𝟙 X)).2,
        apply h₀,
        dsimp only [category_theory.category_struct.id, fm_tr.refl],
        dsimp only [fm_tr.trans, affine_equiv.trans],
        dsimp only [fm_tr.symm, affine_equiv.symm],
        ext,
        dsimp only [coe_fn, has_coe_to_fun.coe],
        simp only [affine_equiv.coe_to_equiv, equiv.to_fun_as_coe, id.def, function.comp_app, affine_equiv.symm_apply_apply,
            equiv.coe_trans, affine_equiv.symm_to_equiv, equiv.coe_refl],
    end
⟩

end implicitK

-- TODO: clean up naming in this file


open tactic

-- Applies a list of tactics in turn, always succeeding.
meta def list_try_seq : list (tactic unit) → tactic unit
| list.nil  := skip
| (t :: ts) := seq (try t) (list_try_seq ts)

-- Applies a list of tactics in turn, succeeding if at least one succeeds.
meta def at_least_one : list (tactic unit) → tactic unit
| list.nil  := fail "at_least_one tactic failed, no more tactics"
| (t :: ts) := (seq t (list_try_seq ts)) <|> (at_least_one ts)

-- FIXME let's try this
meta def simp_at_via_rewrite (h : expr) (extra_lemmas : list expr := []) (cfg : simp_config := {}) : tactic unit :=
do when (expr.is_local_constant h = ff) (fail "tactic simp_at failed, the given expression is not a hypothesis"),
   htype ← infer_type h,
   S     ← simp_lemmas.mk_default,
   S     ← S.append extra_lemmas,
   (new_htype, heq) ← simplify S htype cfg,
   rewrite_at_core reducible tt tt occurrences.all ff heq h

-- set_option pp.all true

lemma {u v} dependent_pair_equality {α : Type u} {Z : α → Type v} { X Y : Σ a : α, Z a } ( p1 : X.1 = Y.1 ) ( p2 : @eq.rec α X.1 Z X.2 Y.1 p1 = Y.2 ) : X = Y :=
begin
  induction X,
  induction Y,
  dsimp at p1,
  dsimp at p2,

end

-- FIXME this repeatedly resimplifies hypotheses, if they can't be cleared. :-(
meta def simp_hypotheses : tactic unit :=
do l ← local_context,
   at_least_one (l.reverse.for (λ h, simp_at h))