import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$.
  assume A : set (euclidean_space ℝ (fin n)),
  assume hA : is_open_cover A,
  -- We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$.
  have h1 : ∃ C : set (euclidean_space ℝ (fin n)), is_open_cover C ∧ is_locally_finite C ∧ is_refinement A C, from by auto [euclidean_space.is_open_ball, euclidean_space.is_open_ball_iff, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_
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 auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
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 auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [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 auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

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

  -- 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 by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
\mathbb{R}^n is paracompact
$\mathbb{R}^n$ is paracompact for all $n$.
`proof`
Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$. We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$. First, we define a collection of pen balls. Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$
centered at 0. Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem, so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$ and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$, and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$). So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$. Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$, there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$), and so $x$ is an element of $\mathcal{C}_m$. Now collection $\mathcal{C}$ is locally finite since for given $x \in \mathbb{R}^n$, neighborhood $B_m$ intersects only finitely many elements of $\mathcal{C}$, namely those elements in collection $\mathcal{C}_1 \cup \mathcal{C}_2 \cup \cdots \mathcal{C}_m$. So $\mathcal{C}$ is a locally finite open refinement of $\mathcal{A}$ that covers $\mathbb{R}^n$, hence $\mathbb{R}^n$ is paracompact.

QED
-/
theorem  ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


import unitb.code.syntax
import unitb.code.instances
import unitb.code.rules
import unitb.code.lemmas
import unitb.refinement.superposition
import unitb.category.transformer

import util.logic
import util.meta.tactic
import util.predicate
import util.data.subtype

import temporal_logic

namespace code.semantics

section
open code predicate temporal nondet

parameters (σ : Type)
@[reducible]
private def pred := pred' σ
parameters {p : nondet.program σ}
parameters {term : pred}
parameters {c : code p.lbl p.first term}

parameter Hterm : ∀ ae : p.lbl, term ⟹ -p.coarse_sch_of ae

structure state :=
  (pc : option (current c))
  (intl : σ)
  (assertion : assert_of pc intl)

parameter {σ}
parameter Hcorr : ∀ pc, state_correctness p c pc

-- include Hcorr

section event

parameter (e : p.lbl)
parameter (s : state)
parameter (h₀ : selects s.pc e)
parameter (h₁ : true)

section implicit

include h₁

theorem evt_guard
: p.guard e s.intl :=
(Hcorr s.pc).enabled e h₀ s.intl s.assertion

theorem evt_coarse_sch
: p.coarse_sch_of e s.intl :=
evt_guard.left

theorem evt_fine_sch
: p.fine_sch_of e s.intl :=
evt_guard.right

end implicit

def machine.run_event (s' : state) : Prop :=
(p.event $ some e).step s.intl evt_coarse_sch evt_fine_sch s'.intl

end event

def machine.step
  (e : current c)
  (s  : state)
  (h : some e = s.pc)
  (s' : state) : Prop :=
  s'.pc = next s.intl s.pc
∧ match action_of e with
   | (sum.inr ⟨l,hl⟩) :=
         have h : selects (s.pc) l,
              by { simp [h] at hl, apply hl },
         machine.run_event l s h trivial s'
   | (sum.inl _) := s'.intl = s.intl
  end

def machine.step_fis
  (e : current c)
  (s  : state)
  (h : some e = s.pc)
: ∃ (s' : state), machine.step e s h s' :=
begin
  destruct action_of e
  ; intros l Hl,
  { have Hss' : assert_of (next s.intl s.pc) s.intl,
    { rw assert_of_next,
      cases l with l H, cases H with P H,
      rw ← h,
      cases classical.em (condition (some e) P s.intl) with Hc Hnc,
      { apply (Hcorr $ some e).cond_true _ _ _ Hc,
        rw h,
        apply s.assertion, },
      { apply (Hcorr $ some e).cond_false _ _ _ Hnc,
        rw h,
        apply s.assertion } },
    let ss' := state.mk (next s.intl s.pc) s.intl Hss',
    existsi ss',
    unfold machine.step,
    split,
    { refl },
    { rw Hl, unfold machine.step._match_1 machine.run_event } },
  { cases l with l hl,
    rw h at hl,
    have CS := evt_coarse_sch Hcorr l s hl trivial,
    have FS := evt_fine_sch Hcorr l s hl trivial,
    cases (p.event l).fis s.intl CS FS with s' H,
    have Hss' : assert_of (next s.intl s.pc) s',
    { rw [assert_of_next],
      apply (Hcorr _).correct _ hl s.intl _ _ ⟨CS,FS,H⟩,
      apply s.assertion },
    let ss' := state.mk (next s.intl s.pc) s' Hss',
    existsi ss',
    unfold machine.step,
    split,
    { refl },
    { rw Hl, unfold machine.step._match_1 machine.run_event,
      apply H } }
end

def machine.event (cur : current c) : nondet.event state :=
  { coarse_sch := λ s, some cur = s.pc
  , fine_sch   := True
  , step := λ s hc _ s', machine.step cur s hc s'
  , fis  := λ s hc _, machine.step_fis cur s hc }

def mch_of : nondet.program state :=
 { lbl := current c
 , lbl_is_sched := by apply_instance
 , first := λ ⟨s₀,s₁,_⟩, s₀ = first c ∧ p.first s₁
 , first_fis :=
   begin cases p.first_fis with s Hs,
         have Hss : assert_of (first c) s,
         { rw assert_of_first, apply Hs },
         let ss := state.mk (first c) s Hss,
         existsi ss,
         unfold mch_of._match_1,
         exact ⟨rfl,Hs⟩
   end
 , event' := machine.event }

@[simp]
lemma coarse_sch_of_mch_of_some (e : mch_of.lbl)
: mch_of.coarse_sch_of (some e) = (λ s : state, some e = s.pc) :=
by { cases e ; refl }

lemma event_mch_of_some (e : mch_of.lbl)
: mch_of.event (some e) = machine.event e :=
by { cases e ; refl }

@[simp]
lemma fine_sch_of_mch_of (e : option mch_of.lbl)
: mch_of.fine_sch_of e = True :=
by { cases e ; refl }

@[simp]
lemma step_of_mch_of (e : mch_of.lbl) (s : state)
: mch_of.step_of (some e) s = (λ s', ∃ Hc : some e = s.pc, machine.step e s Hc s') :=
begin
  apply funext, intro s',
  dunfold code.semantics.mch_of program.step_of program.event program.event',
  dunfold code.semantics.machine.event nondet.event.step_of,
  dunfold event.coarse_sch event.fine_sch event.step,
  apply iff.to_eq,
  apply exists_congr ,
  intro Hc ,
  dsimp [True_eq_true] ,
  rw exists_true,
end

lemma step_event'_mch_of_imp_pc_eq_next (e : mch_of.lbl) (s s' : state)
  (Hc : mch_of.coarse_sch_of (some e) s)
  (Hf : mch_of.fine_sch_of (some e) s)
  (H : (mch_of.event' e).step s Hc Hf s')
: s'.pc = next s.intl s.pc :=
H.left

open superposition

def rel (l : option mch_of.lbl) : option p.lbl → Prop
  | (some e) := selects l e
  | none     := is_control l ∨ l = none

lemma ref_sim (ec : option mch_of.lbl)
: ⟦mch_of.step_of ec⟧ ⟹
      ∃∃ (ea : {ea // rel ec ea}), ⟦p.step_of (ea.val) on state.intl⟧ :=
begin
  rw exists_action,
  apply action_entails_action,
  intros s s' H,
  cases ec with pc,
  case none
  { let x : {ea // rel Hcorr none ea},
    { existsi none, unfold rel is_control, right, refl },
    existsi x, unfold function.on_fun,
    unfold mch_of nondet.program.step_of nondet.program.event
           nondet.skip nondet.event.step_of
           nondet.event.fine_sch nondet.event.coarse_sch
           nondet.event.step  at H,
    unfold nondet.program.step_of nondet.program.event
           nondet.skip nondet.event.step_of
           nondet.event.fine_sch nondet.event.coarse_sch
           nondet.event.step,
    apply exists_imp_exists' (assume _, trivial) _ H, intro,
    apply exists_imp_exists' (assume _, trivial) _, intros _,
    simp, intro, subst s, },
  case some
  { destruct action_of pc,
    case sum.inl
    { intros c Hact,
      cases c with c Hc,
      cases Hc with P Hc,
      let x : {ea // rel Hcorr (some pc) ea},
      { existsi none, unfold rel is_control, left, apply P },
      existsi x,
      unfold function.on_fun nondet.program.step_of nondet.program.event
             nondet.event.step_of,
      unfold nondet.program.step_of nondet.program.event
             nondet.event.step_of at H,
      apply exists_imp_exists' (assume _, trivial) _ H, intro,
      apply exists_imp_exists' (assume _, trivial) _, intros _,
      intros H',
      change _ = _,
      dunfold code.semantics.mch_of nondet.program.event'
              code.semantics.machine.event
              nondet.event.step
              code.semantics.machine.step at H',
      rw Hact at H',
      symmetry, apply H'.right, },
    case sum.inr
    { intros e Hact,
      cases e with e He,
      let x : {ea // rel Hcorr (some pc) ea},
      { existsi (some e), apply He },
      existsi x, unfold function.on_fun,
      dunfold code.semantics.mch_of nondet.program.step_of nondet.program.event
              nondet.program.event' code.semantics.machine.event nondet.event.step_of
              nondet.event.coarse_sch nondet.event.fine_sch
              nondet.event.step at H,
      cases H with Hc H, cases H with Hf H,
      dunfold code.semantics.machine.step at H,
      rw Hact at H, unfold machine.step._match_1 machine.run_event at H,
      rw Hc at He,
      have Hen := (Hcorr s.pc).enabled e He _ s.assertion,
      exact ⟨Hen.left,Hen.right,H.right⟩, }, },
end

section ref_resched

parameter ea : option p.lbl

variable ec : { ec // rel ec ea }

section leads_to

open unitb
parameter pc : current c
parameters p' q' : pred
parameter c' : code p.lbl p' q'
parameter H : subtree c' c
parameter e : p.lbl

@[reducible]
def lt_sched := except (λ s : state, selects s.pc e) (leads_to mch_of)

@[trans]
def lt_sched_trans
  {α} (β) {γ : pred' state}
  (h₀ : lt_sched α β)
  (h₁ : lt_sched β γ)
: lt_sched α γ :=
h₁ <<< h₀

local infix `  ↦.  `:60 := lt_sched

lemma evt_leads_to_aux
: (λ s : state, within H s.pc)
    ↦.
  (λ s : state, exits H s.pc) :=
begin
  induction c',
  case code.skip
  { apply lifted_pred.imp,
    intro s,
    apply not_within_skip },
  case code.action
  { apply except_lift,
    apply @ensure_rule _ (mch_of Hcorr) _ _ (some (counter H)),
      -- EN
    { rw coarse_sch_of_mch_of_some,
      intro s, simp [not_or_iff_not_and_not,and_shunting,exits],
      intros H₀ H₁,
      apply counter_action_of_within H₀ H₁, },
      -- FLW
    { simp [fine_sch_of_mch_of],
      apply leads_to.trivial },
      -- STEP
    { intros s s' Hp Hstep,
      rw step_of_mch_of at Hstep,
      cases Hstep with Hc Hstep,
      unfold machine.step at Hstep,
      cases Hstep with Hstep₀ Hstep₁,
      rw [Hstep₀,← Hc],
      rw next_counter_action,
      unfold exits, },
      -- STABLE
    { apply unless_rule,
      intros ec s Hc Hf s' Hstep Hp,
--      rw [not_or_iff_not_and_not,and_shunting],
      intros Hnq₀,
      right,
      unfold exits,
      have Hp := counter_action_of_within Hp Hnq₀,
      rw [← next_counter_action s.intl H, Hp],
      symmetry,
      apply Hstep.left, }, },
  case code.seq p₀ q r c₀ c₁ ih_1 ih_2 H
  { have Pright : lt_sched Hcorr e
                  (λ (s : state), within H.right (s.pc))
                  (λ (s : state), exits H (s.pc)),
    { simp [exits_iff_exits_right],
      apply ih_2 H.right },
    have Pleft : lt_sched Hcorr e
                 (λ (s : state), within H.left (s.pc))
                 (λ (s : state), exits H (s.pc)),
    { apply lt_sched_trans Hcorr e (λ (s : state), exits H.left (s.pc)),
      { apply ih_1 },
      apply antimono_left,
      { intro, apply exits_left_imp_within_right H },
      { apply Pright } },
    simp [within_left_or_within_right_iff_within_seq],
    apply disj _ Pleft Pright, },
  case code.if_then_else
  { admit },
  case code.while
  { admit },
end

end leads_to

open unitb
include Hterm

lemma evt_leads_to
: (p.coarse_sch_of ea ⋀ (p.event ea).fine_sch) ∘ state.intl
    ↦
      -(p.coarse_sch_of ea ∘ state.intl)
      ⋁ ∃∃ ec : { ec // rel ec ea }, mch_of.coarse_sch_of ec.val
   in mch_of :=
begin
  cases ea with ea,
  { apply unitb.leads_to.imp,
    apply entails_p_or_of_entails_right,
    intros s h, simp,
    let ec : {ec // rel Hcorr ec none},
    { existsi none, apply or.inr, refl },
    existsi [ec.val,ec.property], unfold_local ec,
    simp },
  have H := (evt_leads_to_aux Hcorr _ _ c subtree.rfl ea).run,
  revert H,
  apply unitb.leads_to.monotonicity,
  { intros s q,
    apply within_rfl },
  apply p_or_entails_p_or,
  { -- type_check (term ∘ state.intl),
    -- type_check entails_trans (term ∘ state.intl),
    refine entails_trans (term ∘ state.intl) _ _,
    { intro s, simp [exits],
      intro H,
      have Hasrt := s.assertion,
      rw ← H at Hasrt,
      apply Hasrt, },
    { rw p_not_comp,
      refine comp_entails_comp _ _,
      apply Hterm }, },
  { intros s h,
    let ec : {ec // rel Hcorr ec (some ea)},
    { existsi s.pc, apply h, },
    apply p_exists_intro ec,
    revert ec, simp,
    destruct s.pc,
    { intros h, simp [h], },
    { intros ec Hec, simp [Hec], }, },
end

omit Hterm

lemma evt_resched
: (p.coarse_sch_of ea ⋀ p.fine_sch_of ea) ∘ state.intl ⋀ True
  ⋀ mch_of.coarse_sch_of ec
    >~>
      mch_of.fine_sch_of ec  in  mch_of :=
begin
  simp,
  apply unitb.often_imp_often.basis,
  apply unitb.leads_to.trivial,
end

include Hterm

lemma evt_delay
: (p.coarse_sch_of ea ⋀ (p.event ea).fine_sch) ∘ state.intl
    >~>
      -(p.coarse_sch_of ea ∘ state.intl)
      ⋁ ∃∃ ec : { ec // rel ec ea }, True ⋀ mch_of.coarse_sch_of ec.val
   in mch_of :=
begin
  simp,
  apply often_imp_often.basis,
  apply evt_leads_to Hterm Hcorr ea,
end

omit Hterm

lemma evt_stable
: unless_except mch_of
      (True ⋀ mch_of.coarse_sch_of ec)
      (-(p.coarse_sch_of ea ∘ state.intl))
      { e | ∃ (l : {ec // rel ec ea}), mch_of.event l = e } :=
begin
  apply unless_except_rule,
  intros e s Hc Hf s' Hexcp H₀ H₁ H₂,
  simp [function.comp],
  simp [mem_set_of,not_exists_iff_forall_not] at Hexcp,
  simp [program.event,mch_of,machine.event,program.coarse_sch_of] at H₁ Hc,
  cases ec with ec Hec,
  specialize Hexcp ec Hec,
  cases ec with ec,
  { right, trivial, },
  simp at H₁,
  exfalso, apply Hexcp,
  dsimp [program.event,code.semantics.mch_of,program.event,machine.event] at H₁ Hc,
  rw ← Hc at H₁,
  rw H₁,
  refl
end

lemma evt_sim
:    ⟦mch_of.step_of (ec.val)⟧
 ⟹ ⟦p.step_of ea on state.intl⟧ :=
begin
  apply action_entails_action,
  intros s s',
  dunfold function.on_fun,
  cases ec with ec Hec,
  cases ea,
  case some ea
  { dunfold code.semantics.rel at Hec,
    cases ec with ec,
    { cases Hec },
    { unfold_projs,
      have Hgrd : (machine.event Hcorr ec).coarse_sch s
                → (p.event' ea).guard (s.intl),
      { unfold machine.event,
        unfold nondet.event.coarse_sch, intro H,
        rw H at Hec,
        apply (Hcorr s.pc).enabled _ Hec,
        apply s.assertion },
      have Hcs : (machine.event Hcorr ec).coarse_sch s
               → (p.event' ea).coarse_sch (s.intl),
      { apply and.left ∘ Hgrd },
      rw [step_of_mch_of],
      apply exists_imp_exists' Hcs,
      intros Hcs,
      have Hfs : (p.event' ea).fine_sch (s.intl),
      { apply (Hgrd Hcs).right },
      simp [machine.step],
      destruct action_of ec,
      case sum.inr
      { intros ea' Hea, cases ea' with ea' Hea',
        simp [Hea,machine.step._match_1,machine.run_event],
        intros ea'' Hea'',
        simp [nondet.program.event,mch_of,nondet.program.event'] at *,
        existsi Hfs,
        have H := selects_and_selects_imp_eq _ Hec Hea',
        subst ea', assumption, },
      case sum.inl
      { intros pc Hea, rw Hea,
        simp [machine.step._match_1],
        intros H₀ _, rw H₀,
        cases pc with pc P, cases P with P₀ P₁,
        cases not_selects_and_is_control Hec P₀, } } },
  case none
  { cases ec with ec ;
    simp [program.event],
    { have Hcs : nondet.skip.coarse_sch s → nondet.skip.coarse_sch s.intl,
      { apply id },
      intros Hcs', subst s, },
    { unfold rel at Hec,
      cases Hec,
      case or.inl Hec
        { intros Hc Hstep,
          destruct (action_of ec),
          case sum.inr
            { intros ea Hea₀,
              cases ea with ea Hea₁,
              cases not_selects_and_is_control Hea₁ Hec },
          case sum.inl
            { intros ea Hea,
              simp [Hea,machine.step,machine.step._match_1] at Hstep,
              rw Hstep.left  } },
      case or.inr Hec
        { contradiction } } }
end

lemma ref_resched
: evt_ref_wk state.intl {ec // rel ec ea} mch_of (p.event ea)
      (λ (ec : {ec // rel ec ea}), mch_of.event (ec.val)) :=
{ witness := λ _, True
, resched := evt_resched
, stable  := evt_stable
, delay   := evt_delay
, sim     := evt_sim }

end ref_resched

lemma code_refs_machine
: refined state.intl p mch_of :=
{ sim_init := by { intros i, cases i, apply and.right, }
, ref := rel
, evt_sim := ref_sim
, events := ref_resched }

end

end code.semantics


import condensed.Qprime_isoms

.

noncomputable theory

universes v u u₁ u₂

open category_theory category_theory.limits breen_deligne opposite
open bounded_homotopy_category

namespace Condensed

variables (BD : package)
variables (M N : Condensed.{u} Ab.{u+1}) (f : M ⟶ N)

lemma homology_functor_iso_natural'
  (C₁ C₂ : cochain_complex (Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) ℤ) (g : C₁ ⟶ C₂)
  (S : Profinite.{u}ᵒᵖ) (i : ℤ) :
  (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj S).homology_functor_iso (complex_shape.up ℤ) i).inv.app C₁ ≫
  ((homology_functor (Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) (complex_shape.up ℤ) i).map g).app S =
  category_theory.functor.map _ g ≫
      (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj S).homology_functor_iso (complex_shape.up ℤ) i).inv.app C₂ :=
((((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj S).homology_functor_iso _ i).inv.naturality g).symm

lemma homology_functor_iso_natural (S : ExtrDiscᵒᵖ) (i : ℤ) :
  (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj
      (op (unop S).val)).homology_functor_iso (complex_shape.up ℤ) i).inv.app
    ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M)) ≫
  ((homology_functor (Profiniteᵒᵖ ⥤ Ab) (complex_shape.up ℤ) i).map
     ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f))).app
    (ExtrDisc_to_Profinite.op.obj S) =
  category_theory.functor.map _ (category_theory.functor.map _ (category_theory.functor.map _ f)) ≫
      (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj
        (op (unop S).val)).homology_functor_iso (complex_shape.up ℤ) i).inv.app
      ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj N)) :=
homology_functor_iso_natural' _ _ _ _ _
.

lemma eval_freeAb_iso_component_natural_zero (S : ExtrDiscᵒᵖ) :
  ((((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op (unop S).val)).map_homological_complex
        (complex_shape.up ℤ)).map
       ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f))).f
      (int.of_nat 0) ≫
    (eval_freeAb_iso.component_zero BD N (unop S)).hom =
  (eval_freeAb_iso.component_zero BD M (unop S)).hom ≫
    ((BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).map
       (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op (unop S).val)).map f.val)).f
      (int.of_nat 0) :=
begin
  dsimp only [eval_freeAb_iso.component_zero,
    functor.map_homological_complex_map_f, category_theory.evaluation_obj_map],
  erw [embed_f_0, embed_f_0],
  simp only [functor.map_biproduct, data.eval_functor_obj_map_f,
    whiskering_right_obj_map, whisker_right_app, functor.comp_map,
    functor.map_iso_hom, biproduct.unique_up_to_iso_hom,
    ← functor.map_comp], congr' 2,
  apply biproduct.hom_ext, intro j,
  simp only [category.assoc],
  erw [biproduct.lift_π, biproduct.map_π, biproduct.lift_π_assoc],
  simp only [functor.map_bicone_π, biproduct.bicone_π, evaluation_obj_map],
  simp only [← nat_trans.comp_app], congr' 1,
  rw [biproduct.map_π], refl,
end

lemma eval_freeAb_iso_component_natural_neg (S : ExtrDiscᵒᵖ) (n : ℕ) :
((((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op (unop S).val)).map_homological_complex
        (complex_shape.up ℤ)).map
       ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f))).f
      -[1+ n] ≫
    (eval_freeAb_iso.component_neg BD N (unop S) n).hom =
  (eval_freeAb_iso.component_neg BD M (unop S) n).hom ≫
    ((BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).map
       (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op (unop S).val)).map f.val)).f
      -[1+ n] :=
begin
  dsimp only [eval_freeAb_iso.component_neg,
    functor.map_homological_complex_map_f, category_theory.evaluation_obj_map],
  erw [embed_f_neg, embed_f_neg],
  simp only [functor.map_biproduct, data.eval_functor_obj_map_f,
    whiskering_right_obj_map, whisker_right_app, functor.comp_map,
    functor.map_iso_hom, biproduct.unique_up_to_iso_hom,
    ← functor.map_comp], congr' 2,
  apply biproduct.hom_ext, intro j,
  simp only [category.assoc],
  erw [biproduct.lift_π, biproduct.map_π, biproduct.lift_π_assoc],
  simp only [functor.map_bicone_π, biproduct.bicone_π, evaluation_obj_map],
  simp only [← nat_trans.comp_app], congr' 1,
  rw [biproduct.map_π], refl,
end

lemma eval_freeAb_iso_component_natural (S : ExtrDiscᵒᵖ) :
(eval_freeAb_iso_component BD M (unop S)).inv ≫
    (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op (unop S).val)).map_homological_complex
       (complex_shape.up ℤ)).map
      ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f)) =
  (BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).map
      (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op (unop S).val)).map f.val) ≫
    (eval_freeAb_iso_component BD N (unop S)).inv :=
begin
  rw [iso.inv_comp_eq, ← category.assoc, iso.eq_comp_inv],
  ext ((_|n)|n) : 2,
  { apply eval_freeAb_iso_component_natural_zero },
  { apply is_zero.eq_of_tgt, apply is_zero_zero, },
  { apply eval_freeAb_iso_component_natural_neg },
end
.

lemma eval_freeAb_iso_component_natural_bis (S : ExtrDiscᵒᵖ) (i : ℤ) :
  (homology_functor AddCommGroup (complex_shape.up ℤ) i).map (eval_freeAb_iso_component BD M (unop S)).inv ≫
  (((category_theory.evaluation Profiniteᵒᵖ Ab).obj (op (unop S).val)).map_homological_complex
       (complex_shape.up ℤ) ⋙
     homology_functor Ab (complex_shape.up ℤ) i).map
    ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f)) =
  category_theory.functor.map _ (category_theory.functor.map _ (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj
      (op (unop S).val)).map f.val)) ≫
    (homology_functor AddCommGroup (complex_shape.up ℤ) i).map (eval_freeAb_iso_component BD N (unop S)).inv :=
begin
  rw [functor.comp_map, ← functor.map_comp, ← functor.map_comp], congr' 1,
  apply eval_freeAb_iso_component_natural,
end

lemma tensor_to_unsheafified_homology_natural'_aux (S : ExtrDiscᵒᵖ) (x) :
  ((AddCommGroup.adj.hom_equiv punit (N.val.obj (op (unop S).val))).symm)
  (point
     ((((ExtrSheaf_ExtrSheafProd_equiv Ab).functor.map ((Condensed_ExtrSheaf_equiv Ab).inverse.map f)).val.app S) x)) =
  ((AddCommGroup.adj.hom_equiv punit (M.val.obj (op (unop S).val))).symm) (point x) ≫
    ((category_theory.evaluation Profiniteᵒᵖ Ab).obj (op (unop S).val)).map f.val :=
begin
  dsimp [AddCommGroup.adj, adjunction.mk_of_hom_equiv_hom_equiv],
  apply free_abelian_group.lift.ext, rintro ⟨⟩,
  rw [free_abelian_group.lift.of, comp_apply, free_abelian_group.lift.of],
  refl
end

lemma aaaahrg (i : ℤ) {A B : Ab} (f : A ⟶ B) :
  (homotopy_category.homology_functor AddCommGroup (complex_shape.up ℤ) i).map
  ((BD.eval (forget AddCommGroup ⋙ AddCommGroup.free)).map f) =
  (homology_functor AddCommGroup (complex_shape.up ℤ) i).map
  ((BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).map f) :=
rfl

lemma tensor_to_unsheafified_homology_natural' (i : ℤ) :
  tensor_to_unsheafified_homology BD M i ≫
    whisker_left ExtrDisc_to_Profinite.op
      ((homology_functor (Profiniteᵒᵖ ⥤ Ab) (complex_shape.up ℤ) i).map
         ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f))) =
  (ExtrSheafProd.map_tensor
    ((ExtrSheaf_ExtrSheafProd_equiv Ab).functor.map ((Condensed_ExtrSheaf_equiv Ab).inverse.map f))
      (𝟙 (((BD.eval (forget AddCommGroup ⋙ AddCommGroup.free)).obj (AddCommGroup.free.obj punit)).val.as.homology i))).val ≫
    tensor_to_unsheafified_homology BD N i :=
begin
  ext S : 2,
  dsimp only [tensor_to_unsheafified_homology, nat_trans.comp_app, whisker_left_app,
    ExtrSheafProd.map_tensor_val_app],
  apply AddCommGroup.tensor_ext, intros x y,
  simp only [comp_apply, id_apply, AddCommGroup.map_tensor, tensor_product.map_tmul,
    AddCommGroup.tensor_uncurry, linear_map.to_add_monoid_hom_coe,
    tensor_product.lift.tmul, add_monoid_hom.coe_mk,
    linear_map.comp_apply, add_monoid_hom.coe_to_int_linear_map],
  dsimp only [tensor_to_unsheafified_homology_component, add_monoid_hom.mk'_apply,
    tensor_to_unsheafified_homology_component_applied],
  simp only [← comp_apply, category.assoc], congr' 1,
  rw homology_functor_iso_natural,
  simp only [← category.assoc], congr' 1, simp only [category.assoc],
  rw eval_freeAb_iso_component_natural_bis,
  simp only [← category.assoc], congr' 1,
  rw [tensor_to_unsheafified_homology_natural'_aux],
  rw [aaaahrg, aaaahrg, ← category_theory.functor.map_comp, ← category_theory.functor.map_comp],
end

lemma tensor_to_homology_natural (i : ℤ) :
  tensor_to_homology.{u} BD M i ≫ (homology_functor (Condensed.{u} Ab.{u+1}) _ i).map
      ((BD.eval' freeCond').map f) =
  map_tensor f (𝟙 _) ≫ tensor_to_homology.{u} BD N i :=
begin
  simp only [tensor_to_homology, category.assoc, ← functor.map_comp,
    eval_freeCond'_iso_component_natural],
  simp only [functor.map_comp],
  simp only [← category.assoc], refine congr_arg2 _ _ rfl, simp only [category.assoc],
  have := (homology_functor_sheafification_iso (complex_shape.up ℤ) i).hom.naturality
    ((Condensed_Ab_to_presheaf ⋙ BD.eval' freeFunc).map f),
  erw [← this], clear this,
  simp only [← category.assoc], refine congr_arg2 _ _ rfl, simp only [category.assoc],
  dsimp only [iso.app_hom],
  have := (Condensed_ExtrSheaf_equiv Ab.{u+1}).counit_iso.hom.naturality
    ((homology_functor (Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) _ i ⋙
      presheaf_to_Condensed_Ab).map ((Condensed_Ab_to_presheaf ⋙ BD.eval' freeFunc.{u u+1}).map f)),
  erw [← this], clear this,
  simp only [← category.assoc], refine congr_arg2 _ _ rfl, simp only [category.assoc],
  dsimp only [map_tensor, functor.comp_map],
  simp only [← functor.map_comp], congr' 1,
  have := ExtrDisc_sheafification_iso.hom.naturality
    ((homology_functor (Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) _ i).map
      ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f))),
  erw [← this], clear this,
  simp only [← category.assoc], refine congr_arg2 _ _ rfl,
  ext1,
  dsimp only [tensor_to_homology_aux],
  simp only [functor.comp_map, whiskering_left_obj_map, Sheaf.category_theory.category_comp_val,
    presheaf_to_Sheaf_map_val, ExtrSheaf.map_tensor_val,
    grothendieck_topology.to_sheafify_naturality, category.assoc,
    grothendieck_topology.to_sheafify_naturality_assoc, ← grothendieck_topology.sheafify_map_comp],
  rw [tensor_to_unsheafified_homology_natural'],
end

lemma homology_bd_eval_natural
  [∀ S : ExtrDisc.{u}, no_zero_smul_divisors ℤ (M.val.obj (op S.val))]
  [∀ S : ExtrDisc.{u}, no_zero_smul_divisors ℤ (N.val.obj (op S.val))] (i : ℤ) :
  (homology_bd_eval BD M i).inv ≫ (homology_functor _ _ i).map ((BD.eval' freeCond').map f) =
  map_tensor f (𝟙 _) ≫ (homology_bd_eval BD N i).inv :=
tensor_to_homology_natural BD M N f i

end Condensed


import analysis.normed.group.SemiNormedGroup.kernels
import algebra.homology.additive

namespace SemiNormedGroup

protected class strict_iso {A B : SemiNormedGroup} (f : A ≅ B) :=
(strict_hom' : ∀ a : A, ∥f.hom a∥₊ = ∥a∥₊)

@[simp]
lemma strict_iso_hom {A B : SemiNormedGroup} (f : A ≅ B) [strict_iso f] (a : A) :
  ∥f.hom a∥₊ = ∥a∥₊ := strict_iso.strict_hom' _

@[simp]
lemma strict_iso_inv {A B : SemiNormedGroup} (f : A ≅ B) [strict_iso f] (b : B) :
  ∥f.inv b∥₊ = ∥b∥₊ :=
begin
  have : b = f.hom (f.inv b),
  { change b = (f.inv ≫ f.hom) b, simp },
  conv_rhs {rw this},
  rw strict_iso_hom,
end

end SemiNormedGroup

structure strict_iso (C D : cochain_complex SemiNormedGroup ℕ) :=
(iso : C ≅ D)
[is_strict : ∀ i : ℕ, SemiNormedGroup.strict_iso $ (homological_complex.eval _ _ i).map_iso iso]

instance (C D : cochain_complex SemiNormedGroup ℕ) (f : strict_iso C D) (n : ℕ) :
  SemiNormedGroup.strict_iso ((homological_complex.eval _ _ n).map_iso f.iso) := f.is_strict _


lemma eq_mp_heq :
  ∀ {α β : Sort*} {a : α} {a' : β} (h₂ : a == a'), (eq.mp (type_eq_of_heq h₂) a) = a'
| α ._ a a' heq.rfl := rfl


/-
File: signature_recover_public_key_get_point_from_x_soundness.lean

Autogenerated file.
-/
import starkware.cairo.lean.semantics.soundness.hoare
import .signature_recover_public_key_code
import ..signature_recover_public_key_spec
import .signature_recover_public_key_validate_reduced_field_element_soundness
import .signature_recover_public_key_reduce_soundness
import .signature_recover_public_key_unreduced_sqr_soundness
import .signature_recover_public_key_unreduced_mul_soundness
open tactic

open starkware.cairo.common.cairo_secp.signature
open starkware.cairo.common.cairo_secp.constants
open starkware.cairo.common.math
open starkware.cairo.common.cairo_secp.field
open starkware.cairo.common.cairo_secp.ec
open starkware.cairo.common.cairo_secp.bigint

variables {F : Type} [field F] [decidable_eq F] [prelude_hyps F]
variable  mem : F → F
variable  σ : register_state F

/- starkware.cairo.common.cairo_secp.signature.get_point_from_x autogenerated soundness theorem -/

theorem auto_sound_get_point_from_x
    -- arguments
    (range_check_ptr : F) (x : BigInt3 F) (v : F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_get_point_from_x σ.pc)
    -- all dependencies are in memory
    (h_mem_0 : mem_at mem code_assert_nn (σ.pc  - 751))
    (h_mem_1 : mem_at mem code_assert_le (σ.pc  - 747))
    (h_mem_2 : mem_at mem code_assert_nn_le (σ.pc  - 742))
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 719))
    (h_mem_5 : mem_at mem code_unreduced_mul (σ.pc  - 707))
    (h_mem_6 : mem_at mem code_unreduced_sqr (σ.pc  - 687))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 671))
    (h_mem_9 : mem_at mem code_reduce (σ.pc  - 612))
    (h_mem_10 : mem_at mem code_validate_reduced_field_element (σ.pc  - 599))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 7))
    (hin_x : x = cast_BigInt3 mem (σ.fp - 6))
    (hin_v : v = mem (σ.fp - 3))
    -- conclusion
  : ensures_ret mem σ (λ κ τ,
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 7)) (mem $ τ.ap - 7)
        (spec_get_point_from_x mem κ range_check_ptr x v (mem (τ.ap - 7)) (cast_EcPoint mem (τ.ap - 6)))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_get_point_from_x at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4, hpc5, hpc6, hpc7, hpc8, hpc9, hpc10, hpc11, hpc12, hpc13, hpc14, hpc15, hpc16, hpc17, hpc18, hpc19, hpc20, hpc21, hpc22, hpc23, hpc24, hpc25, hpc26, hpc27, hpc28, hpc29, hpc30, hpc31, hpc32, hpc33, hpc34, hpc35, hpc36, hpc37, hpc38, hpc39, hpc40, hpc41, hpc42, hpc43, hpc44, hpc45, hpc46, hpc47, hpc48, hpc49, hpc50, hpc51, hpc52, hpc53, hpc54, hpc55, hpc56, hpc57, hpc58, hpc59, hpc60, hpc61, hpc62, hpc63, hpc64, hpc65⟩,
  -- ap += 6
  step_advance_ap hpc0 hpc1,
  -- function call
  step_assert_eq hpc2 with arg0,
  step_assert_eq hpc3 with arg1,
  step_sub hpc4 (auto_sound_assert_nn mem _ range_check_ptr v _ _ _),
  { rw hpc5, norm_num2, exact h_mem_0 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v] },
    try { dsimp [cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v] },
    try { dsimp [cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call6 ap6 h_call6,
  rcases h_call6 with ⟨h_call6_ap_offset, h_call6⟩,
  rcases h_call6 with ⟨rc_m6, rc_mle6, hl_range_check_ptr₁, h_call6⟩,
  generalize' hr_rev_range_check_ptr₁: mem (ap6 - 1) = range_check_ptr₁,
  have htv_range_check_ptr₁ := hr_rev_range_check_ptr₁.symm, clear hr_rev_range_check_ptr₁,
  try { simp only [arg0 ,arg1] at hl_range_check_ptr₁ },
  rw [←htv_range_check_ptr₁, ←hin_range_check_ptr] at hl_range_check_ptr₁,
  try { simp only [arg0 ,arg1] at h_call6 },
  rw [hin_range_check_ptr] at h_call6,
  clear arg0 arg1,
  -- function call
  step_assert_eq hpc6 with arg0,
  step_assert_eq hpc7 with arg1,
  step_assert_eq hpc8 with arg2,
  step_sub hpc9 (auto_sound_unreduced_sqr mem _ x _ _),
  { rw hpc10, norm_num2, exact h_mem_6 },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁] },
      try { dsimp [cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2] },
      try { simp only [h_call6_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call11 ap11 h_call11,
  rcases h_call11 with ⟨h_call11_ap_offset, h_call11⟩,
  generalize' hr_rev_x_square: cast_UnreducedBigInt3 mem (ap11 - 3) = x_square,
  simp only [hr_rev_x_square] at h_call11,
  have htv_x_square := hr_rev_x_square.symm, clear hr_rev_x_square,
  clear arg0 arg1 arg2,
  -- function call
  step_assert_eq hpc11 with arg0,
  step_assert_eq hpc12 with arg1,
  step_assert_eq hpc13 with arg2,
  step_assert_eq hpc14 with arg3,
  step_sub hpc15 (auto_sound_reduce mem _ range_check_ptr₁ x_square _ _ _ _ _),
  { rw hpc16, norm_num2, exact h_mem_9 },
  { rw hpc16, norm_num2, exact h_mem_4 },
  { rw hpc16, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3] },
    try { simp only [h_call6_ap_offset, h_call11_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call17 ap17 h_call17,
  rcases h_call17 with ⟨h_call17_ap_offset, h_call17⟩,
  rcases h_call17 with ⟨rc_m17, rc_mle17, hl_range_check_ptr₂, h_call17⟩,
  generalize' hr_rev_range_check_ptr₂: mem (ap17 - 4) = range_check_ptr₂,
  have htv_range_check_ptr₂ := hr_rev_range_check_ptr₂.symm, clear hr_rev_range_check_ptr₂,
  generalize' hr_rev_x_square_reduced: cast_BigInt3 mem (ap17 - 3) = x_square_reduced,
  simp only [hr_rev_x_square_reduced] at h_call17,
  have htv_x_square_reduced := hr_rev_x_square_reduced.symm, clear hr_rev_x_square_reduced,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3] at hl_range_check_ptr₂ },
  try { rw [h_call11_ap_offset] at hl_range_check_ptr₂ }, try { arith_simps at hl_range_check_ptr₂ },
  rw [←htv_range_check_ptr₂, ←htv_range_check_ptr₁] at hl_range_check_ptr₂,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3] at h_call17 },
  try { rw [h_call11_ap_offset] at h_call17 }, try { arith_simps at h_call17 },
  rw [←htv_range_check_ptr₁, hl_range_check_ptr₁, hin_range_check_ptr] at h_call17,
  clear arg0 arg1 arg2 arg3,
  -- function call
  step_assert_eq hpc17 with arg0,
  step_assert_eq hpc18 with arg1,
  step_assert_eq hpc19 with arg2,
  step_assert_eq hpc20 with arg3,
  step_assert_eq hpc21 with arg4,
  step_assert_eq hpc22 with arg5,
  step_sub hpc23 (auto_sound_unreduced_mul mem _ x x_square_reduced _ _ _),
  { rw hpc24, norm_num2, exact h_mem_5 },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call25 ap25 h_call25,
  rcases h_call25 with ⟨h_call25_ap_offset, h_call25⟩,
  generalize' hr_rev_x_cube: cast_UnreducedBigInt3 mem (ap25 - 3) = x_cube,
  simp only [hr_rev_x_cube] at h_call25,
  have htv_x_cube := hr_rev_x_cube.symm, clear hr_rev_x_cube,
  clear arg0 arg1 arg2 arg3 arg4 arg5,
  -- local var
  step_assert_eq hpc25 with temp0,
  step_assert_eq hpc26 with temp1,
  step_assert_eq hpc27 with temp2,
  have lc_x_cube: x_cube = cast_UnreducedBigInt3 mem σ.fp, {
    try { ext } ; {
      try { simp only [htv_x_cube] },
      try { dsimp [cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [temp0, temp1, temp2] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  clear temp0 temp1 temp2,
  -- function call
  step_assert_eq hpc28 with arg0,
  step_sub hpc29 (auto_sound_nondet_bigint3 mem _ range_check_ptr₂ _ _),
  { rw hpc30, norm_num2, exact h_mem_4 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0] },
    try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call31 ap31 h_call31,
  rcases h_call31 with ⟨h_call31_ap_offset, h_call31⟩,
  rcases h_call31 with ⟨rc_m31, rc_mle31, hl_range_check_ptr₃, h_call31⟩,
  generalize' hr_rev_range_check_ptr₃: mem (ap31 - 4) = range_check_ptr₃,
  have htv_range_check_ptr₃ := hr_rev_range_check_ptr₃.symm, clear hr_rev_range_check_ptr₃,
  generalize' hr_rev_y: cast_BigInt3 mem (ap31 - 3) = y,
  simp only [hr_rev_y] at h_call31,
  have htv_y := hr_rev_y.symm, clear hr_rev_y,
  try { simp only [arg0] at hl_range_check_ptr₃ },
  try { rw [h_call25_ap_offset] at hl_range_check_ptr₃ }, try { arith_simps at hl_range_check_ptr₃ },
  rw [←htv_range_check_ptr₃, ←htv_range_check_ptr₂] at hl_range_check_ptr₃,
  try { simp only [arg0] at h_call31 },
  try { rw [h_call25_ap_offset] at h_call31 }, try { arith_simps at h_call31 },
  rw [←htv_range_check_ptr₂, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call31,
  clear arg0,
  -- local var
  step_assert_eq hpc31 with temp0,
  step_assert_eq hpc32 with temp1,
  step_assert_eq hpc33 with temp2,
  have lc_y: y = cast_BigInt3 mem (σ.fp + 3), {
    try { ext } ; {
      try { simp only [htv_y] },
      try { dsimp [cast_BigInt3] },
      try { arith_simps }, try { simp only [temp0, temp1, temp2] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  clear temp0 temp1 temp2,
  -- function call
  step_assert_eq hpc34 with arg0,
  step_assert_eq hpc35 with arg1,
  step_assert_eq hpc36 with arg2,
  step_assert_eq hpc37 with arg3,
  step_sub hpc38 (auto_sound_validate_reduced_field_element mem _ range_check_ptr₃ y _ _ _ _ _ _),
  { rw hpc39, norm_num2, exact h_mem_10 },
  { rw hpc39, norm_num2, exact h_mem_0 },
  { rw hpc39, norm_num2, exact h_mem_1 },
  { rw hpc39, norm_num2, exact h_mem_2 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3] },
    try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call40 ap40 h_call40,
  rcases h_call40 with ⟨rc_m40, rc_mle40, hl_range_check_ptr₄, h_call40⟩,
  generalize' hr_rev_range_check_ptr₄: mem (ap40 - 1) = range_check_ptr₄,
  have htv_range_check_ptr₄ := hr_rev_range_check_ptr₄.symm, clear hr_rev_range_check_ptr₄,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3] at hl_range_check_ptr₄ },
  rw [←htv_range_check_ptr₄, ←htv_range_check_ptr₃] at hl_range_check_ptr₄,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3] at h_call40 },
  rw [←htv_range_check_ptr₃, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call40,
  clear arg0 arg1 arg2 arg3,
  -- function call
  step_assert_eq hpc40 with arg0,
  step_assert_eq hpc41 with arg1,
  step_assert_eq hpc42 hpc43 with arg2,
  have h_δ40_c0 : ∀ x : F, x / (2 : ℤ) = x * (-1809251394333065606848661391547535052811553607665798349986546028067936010240 : ℤ),
  { intro x,  apply div_eq_mul_inv', apply PRIME.int_cast_mul_eq_one, rw [PRIME], try { simp_int_casts }, norm_num1 },
  have h_δ40_c0_fz : ∀ x : F, x / 2 = x / (2 : ℤ), { intro x, norm_cast },
  step_sub hpc44 (auto_sound_assert_nn mem _ range_check_ptr₄ ((y.d0 + v) / (2 : ℤ)) _ _ _),
  { rw hpc45, norm_num2, exact h_mem_0 },
  { try { simp only [h_δ40_c0_fz, h_δ40_c0] }, try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y, htv_range_check_ptr₄] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2] },
    try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { simp only [h_δ40_c0_fz, h_δ40_c0] }, try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y, htv_range_check_ptr₄] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2] },
    try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call46 ap46 h_call46,
  rcases h_call46 with ⟨h_call46_ap_offset, h_call46⟩,
  rcases h_call46 with ⟨rc_m46, rc_mle46, hl_range_check_ptr₅, h_call46⟩,
  generalize' hr_rev_range_check_ptr₅: mem (ap46 - 1) = range_check_ptr₅,
  have htv_range_check_ptr₅ := hr_rev_range_check_ptr₅.symm, clear hr_rev_range_check_ptr₅,
  try { simp only [arg0 ,arg1 ,arg2] at hl_range_check_ptr₅ },
  rw [←htv_range_check_ptr₅, ←htv_range_check_ptr₄] at hl_range_check_ptr₅,
  try { simp only [arg0 ,arg1 ,arg2] at h_call46 },
  rw [←htv_range_check_ptr₄, hl_range_check_ptr₄, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call46,
  clear arg0 arg1 arg2,
  -- function call
  step_assert_eq hpc46 with arg0,
  step_assert_eq hpc47 with arg1,
  step_assert_eq hpc48 with arg2,
  step_sub hpc49 (auto_sound_unreduced_sqr mem _ y _ _),
  { rw hpc50, norm_num2, exact h_mem_6 },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y, htv_range_check_ptr₄, htv_range_check_ptr₅] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset, h_call46_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call51 ap51 h_call51,
  rcases h_call51 with ⟨h_call51_ap_offset, h_call51⟩,
  generalize' hr_rev_y_square: cast_UnreducedBigInt3 mem (ap51 - 3) = y_square,
  simp only [hr_rev_y_square] at h_call51,
  have htv_y_square := hr_rev_y_square.symm, clear hr_rev_y_square,
  clear arg0 arg1 arg2,
  -- function call
  step_assert_eq hpc51 hpc52 with arg0,
  step_assert_eq hpc53 with arg1,
  step_assert_eq hpc54 with arg2,
  step_assert_eq hpc55 with arg3,
  step_assert_eq hpc56 with arg4,
  step_sub hpc57 (auto_sound_verify_zero mem _ range_check_ptr₅ {
    d0 := x_cube.d0 + BETA - y_square.d0,
    d1 := x_cube.d1 - y_square.d1,
    d2 := x_cube.d2 - y_square.d2
  } _ _ _),
  { rw hpc58, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y, htv_range_check_ptr₄, htv_range_check_ptr₅, htv_y_square] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, (eq_sub_of_eq_add arg2), (eq_sub_of_eq_add arg3), (eq_sub_of_eq_add arg4)] },
    try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset, h_call46_ap_offset, h_call51_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y, htv_range_check_ptr₄, htv_range_check_ptr₅, htv_y_square] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, (eq_sub_of_eq_add arg2), (eq_sub_of_eq_add arg3), (eq_sub_of_eq_add arg4)] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset, h_call46_ap_offset, h_call51_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call59 ap59 h_call59,
  rcases h_call59 with ⟨h_call59_ap_offset, h_call59⟩,
  rcases h_call59 with ⟨rc_m59, rc_mle59, hl_range_check_ptr₆, h_call59⟩,
  generalize' hr_rev_range_check_ptr₆: mem (ap59 - 1) = range_check_ptr₆,
  have htv_range_check_ptr₆ := hr_rev_range_check_ptr₆.symm, clear hr_rev_range_check_ptr₆,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4] at hl_range_check_ptr₆ },
  try { rw [h_call51_ap_offset] at hl_range_check_ptr₆ }, try { arith_simps at hl_range_check_ptr₆ },
  rw [←htv_range_check_ptr₆, ←htv_range_check_ptr₅] at hl_range_check_ptr₆,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4] at h_call59 },
  try { rw [h_call51_ap_offset] at h_call59 }, try { arith_simps at h_call59 },
  rw [←htv_range_check_ptr₅, hl_range_check_ptr₅, hl_range_check_ptr₄, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call59,
  clear arg0 arg1 arg2 arg3 arg4,
  -- return
  step_assert_eq hpc59 with hret0,
  step_assert_eq hpc60 with hret1,
  step_assert_eq hpc61 with hret2,
  step_assert_eq hpc62 with hret3,
  step_assert_eq hpc63 with hret4,
  step_assert_eq hpc64 with hret5,
  step_ret hpc65,
  -- finish
  step_done, use_only [rfl, rfl],
  -- range check condition
  use_only (rc_m6+rc_m17+rc_m31+rc_m40+rc_m46+rc_m59+0+0), split,
  linarith [rc_mle6, rc_mle17, rc_mle31, rc_mle40, rc_mle46, rc_mle59],
  split,
  { arith_simps, try { simp only [hret0 ,hret1 ,hret2 ,hret3 ,hret4 ,hret5] },
    rw [←htv_range_check_ptr₆, hl_range_check_ptr₆, hl_range_check_ptr₅, hl_range_check_ptr₄, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr],
    try { arith_simps, refl <|> norm_cast }, try { refl } },
  intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
  have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
  -- Final Proof
  -- user-provided reduction
  suffices auto_spec: auto_spec_get_point_from_x mem _ range_check_ptr x v _ _,
  { apply sound_get_point_from_x, apply auto_spec },
  -- prove the auto generated assertion
  dsimp [auto_spec_get_point_from_x],
  try { norm_num1 }, try { arith_simps },
  use_only [κ_call6],
  use_only [range_check_ptr₁],
  have rc_h_range_check_ptr₁ := range_checked_offset' rc_h_range_check_ptr,
  have rc_h_range_check_ptr₁' := range_checked_add_right rc_h_range_check_ptr₁, try { norm_cast at rc_h_range_check_ptr₁' },
  have spec6 := h_call6 rc_h_range_check_ptr',
  rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec6,
  try { dsimp at spec6, arith_simps at spec6 },
  use_only [spec6],
  use_only [κ_call11],
  use_only [x_square],
  try { dsimp at h_call11, arith_simps at h_call11 },
  try { use_only [h_call11] },
  use_only [κ_call17],
  use_only [range_check_ptr₂],
  use_only [x_square_reduced],
  have rc_h_range_check_ptr₂ := range_checked_offset' rc_h_range_check_ptr₁,
  have rc_h_range_check_ptr₂' := range_checked_add_right rc_h_range_check_ptr₂, try { norm_cast at rc_h_range_check_ptr₂' },
  have spec17 := h_call17 rc_h_range_check_ptr₁',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←htv_range_check_ptr₂] at spec17,
  try { dsimp at spec17, arith_simps at spec17 },
  use_only [spec17],
  use_only [κ_call25],
  use_only [x_cube],
  try { dsimp at h_call25, arith_simps at h_call25 },
  try { use_only [h_call25] },
  use_only [κ_call31],
  use_only [range_check_ptr₃],
  use_only [y],
  have rc_h_range_check_ptr₃ := range_checked_offset' rc_h_range_check_ptr₂,
  have rc_h_range_check_ptr₃' := range_checked_add_right rc_h_range_check_ptr₃, try { norm_cast at rc_h_range_check_ptr₃' },
  have spec31 := h_call31 rc_h_range_check_ptr₂',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←htv_range_check_ptr₃] at spec31,
  try { dsimp at spec31, arith_simps at spec31 },
  use_only [spec31],
  use_only [κ_call40],
  use_only [range_check_ptr₄],
  have rc_h_range_check_ptr₄ := range_checked_offset' rc_h_range_check_ptr₃,
  have rc_h_range_check_ptr₄' := range_checked_add_right rc_h_range_check_ptr₄, try { norm_cast at rc_h_range_check_ptr₄' },
  have spec40 := h_call40 rc_h_range_check_ptr₃',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←hl_range_check_ptr₃, ←htv_range_check_ptr₄] at spec40,
  try { dsimp at spec40, arith_simps at spec40 },
  use_only [spec40],
  use_only [κ_call46],
  use_only [range_check_ptr₅],
  have rc_h_range_check_ptr₅ := range_checked_offset' rc_h_range_check_ptr₄,
  have rc_h_range_check_ptr₅' := range_checked_add_right rc_h_range_check_ptr₅, try { norm_cast at rc_h_range_check_ptr₅' },
  have spec46 := h_call46 rc_h_range_check_ptr₄',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←hl_range_check_ptr₃, ←hl_range_check_ptr₄, ←htv_range_check_ptr₅] at spec46,
  try { dsimp at spec46, arith_simps at spec46 },
  use_only [spec46],
  use_only [κ_call51],
  use_only [y_square],
  try { dsimp at h_call51, arith_simps at h_call51 },
  try { use_only [h_call51] },
  use_only [κ_call59],
  use_only [range_check_ptr₆],
  have rc_h_range_check_ptr₆ := range_checked_offset' rc_h_range_check_ptr₅,
  have rc_h_range_check_ptr₆' := range_checked_add_right rc_h_range_check_ptr₆, try { norm_cast at rc_h_range_check_ptr₆' },
  have spec59 := h_call59 rc_h_range_check_ptr₅',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←hl_range_check_ptr₃, ←hl_range_check_ptr₄, ←hl_range_check_ptr₅, ←htv_range_check_ptr₆] at spec59,
  try { dsimp at spec59, arith_simps at spec59 },
  use_only [spec59],
  try { split, linarith },
  try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y, htv_range_check_ptr₄, htv_range_check_ptr₅, htv_y_square, htv_range_check_ptr₆] }, },
  try { dsimp [cast_BigInt3, cast_UnreducedBigInt3, cast_EcPoint] },
  try { arith_simps }, try { simp only [hret0, hret1, hret2, hret3, hret4, hret5] },
  try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset, h_call46_ap_offset, h_call51_ap_offset, h_call59_ap_offset] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end


import for_mathlib.derived_functor
import category_theory.abelian.left_derived

universes w v u

noncomputable theory

namespace category_theory.abelian.functor

open category_theory category_theory.functor category_theory.limits
open category_theory.functor.left_derived

variables {C : Type u} {D : Type u} [category.{w} C] [category.{w} D] [enough_projectives C]
variables (F : C ⥤ D) {A₁ A₂ A₃ X : C} {f : A₁ ⟶ A₂} {g : A₂ ⟶ A₃}
variables [abelian C] [abelian D] [additive F] [preserves_finite_colimits F]

section les

def δ₀ (A : short_exact_sequence C) := δ F 0 A ≫ (left_derived_zero_iso_self F).hom.app A.1

lemma seven_term_exact_seq (A : short_exact_sequence C) :
  exact_seq D [
    (F.left_derived 1).map A.f, (F.left_derived 1).map A.g,
    δ₀ F A,
    F.map A.f, F.map A.g, (0 : F.obj A.3 ⟶ F.obj A.3)] :=
begin
  refine exact_seq.cons _ _ (exact_of_short_exact _ _ _) _ (exact_seq.cons _ _ _ _ _),
  { refine preadditive.exact_of_iso_of_exact' ((F.left_derived 1).map A.g) (δ F 0 A) _ _
      (iso.refl _) (iso.refl _) ((left_derived_zero_iso_self F).app A.1) (by simp) _ _,
    { dsimp [δ₀], rw [category.id_comp] },
    { exact (exact_iff_exact_seq _ _).2 ((six_term_exact_seq F 0 A).extract 1 2) } },
  refine exact_seq.cons _ _ _ _ _,
  { refine preadditive.exact_of_iso_of_exact' (δ F 0 A) ((F.left_derived 0).map A.f) _ _
      (iso.refl _) ((left_derived_zero_iso_self F).app A.1) ((left_derived_zero_iso_self F).app A.2)
      _ (by simp) _,
    { dsimp [δ₀], rw [category.id_comp] },
    { exact (exact_iff_exact_seq _ _).2 ((six_term_exact_seq F 0 A).extract 2 2) } },
    apply exact_seq.cons,
    { exact preserves_exact_of_preserves_finite_colimits_of_epi _ A.exact' },
    { rw [← exact_iff_exact_seq],
      exact ((abelian.tfae_epi (F.obj A.3) (F.map A.g)).out 0 2).1
        (category_theory.preserves_epi _ _) }
end

end les

end category_theory.abelian.functor


import data.real.basic

theorem exo:
  (forall (a b c: real), ((2*a + b + c)^2)/(2*a^2 + (b + c)^2) + ((2*b + c + a)^2)/(2*b^2 + (c + a)^2) + ((2*c + a + b)^2)/(2*c^2 + (a + b)^2) <= 8)
:=
  sorry


import feather_model.basic

open_locale classical

open feather_model

@[reducible] def 𝕋 := mterm (finset V)

/-- To establish a base case for the model, we create the "empty" model level. -/
instance : term_struct (finset V) := {
  var := λ v, {v},
  bound := id,
  subst := λ v e f, if v ∈ f then f.erase v ∪ e else f,
  is_type := λ _ _, true,
  runtime_ok := λ _, true,
  rir_ok := λ _, true,
  runtime_judgments := λ _, true,
  rir_judgments := λ _, true,
  defeq := λ _ _ _ _, true,
  sort := λ _, ∅,
  representable := λ s f, f,
}

instance : type_data (finset V) := ⟨λ _ _, true, λ _, true⟩

instance : term (finset V) :=
begin
  refine_struct { .. };
  intros; try { trivial },
  { unfold subst,
    rw if_neg,
    assumption, },
  { unfold subst,
    rw if_pos,
    refl,
    assumption, },
end

example : term_struct 𝕋 := infer_instance


-- author: Ben Sherman
import .action
       galois.tactic
       galois.option
       galois.temporal.temporal

universes u v

namespace network

structure incoming_items :=
  (messages : list (socket × message_t))

def lookup_updatef {A : Type u} [decidable_eq A] {B : A → Type v}
  (a : A) (f : B a → B a) (m : ∀ a, B a) (x : A) : B x
:= if H : a = x
  then eq.rec_on H (f (m a))
  else m x

def lookup_update {A : Type u} [decidable_eq A] {B : A → Type v}
  (a : A) (b : B a) : (∀ a, B a) → (∀ a, B a)
:= lookup_updatef a (λ _, b)

lemma lookup_update_refl {A : Type u} [decidable_eq A] {B : A → Type v}
  {a : A} {b : B a} {f : ∀ a, B a} :
  lookup_update a b f a = b
:= begin
unfold lookup_update lookup_updatef,
rw (dif_pos (eq.refl a)),
end

lemma lookup_update_different {A : Type u} [decidable_eq A] {B : A → Type v}
  {a a' : A} {b : B a} {f : ∀ a, B a} (H : a ≠ a') :
  lookup_update a b f a' = f a'
:= begin
unfold lookup_update lookup_updatef,
rw (dif_neg H),
end

@[reducible]
def global_state_t := ip → incoming_items

def initial_incoming_items : incoming_items
  := { messages := [] }

def poll_label.to_poll_result
  (ports : list port) (sockets : list socket) (bound : time)
  (incoming : incoming_items)
  : poll_label → option (poll_result ports sockets bound)
| poll_label.timeout := some poll_result.timeout
| (poll_label.receive elapsed rn mess) := do
  plift.up (and.intro H H') ← option.precondition (elapsed < bound ∧ 0 < elapsed),
  idx ← list.check_member_st (λ p : socket × message_t, p.snd = mess) incoming.messages,
  sockidx ← list.check_member idx.to_member.value.fst sockets, --any other checks necessary?
  some (poll_result.message ⟨ elapsed, H ⟩ sockidx mess H')

def agent_label.to_dlabel
  (incoming : incoming_items) {ag : agent}
: ∀ (a_next : act ag.state_type), agent_label → option (dlabel a_next)
| (act.poll ports sockets bound cont) (agent_label.mk plabel ms) := do
   r ← plabel.to_poll_result ports sockets bound incoming,
   guard ((cont r).fst = ms),
   some (dlabel.poll ports sockets bound cont r)

def add_message (rn : remote_name) (m : message_t) (a_ip : ip)
  : global_state_t → global_state_t :=
  lookup_updatef a_ip (λ i : incoming_items, {i with messages := (rn, m) :: i.messages })

def dlabel_to_label {A} : ∀ {a_next : act A}, dlabel a_next → agent_label
| (act.poll ports sockets bound cont) (dlabel.poll ._ ._ ._ ._ r) :=
  agent_label.mk r.to_label ((cont r).fst)

section
parameter {agents : map ip agent}

structure system_state : Type 1 :=
  (local_state : ∀ a : agents.member, a.value.state_type)
  (global_state : global_state_t)

structure sys_dlabel (st : system_state) :=
  (ag : agents.member)
  (label : dlabel (ag.value.loop (st.local_state ag)))

section
parameters (a_ip : ip) (ag : agent) (incoming : incoming_items)

def apply_message_updates (ms : list (socket × message_t))
   (updatef : global_state_t → global_state_t)
  : global_state_t → global_state_t
  := let fs := (list.map (λ p : socket × message_t, let (sock, mess) := p in
      add_message (a_ip, sock.snd) mess sock.fst) ms) in
     list.foldr function.comp updatef fs

def next_agent_state_poll_dlabel {A : Type} {ports : list port} {sockets : list socket}
  {bound : time} (cont : poll_result ports sockets bound → A)
  : poll_result ports sockets bound
  → option (global_state_t → global_state_t)
| poll_result.timeout := some id
| (poll_result.message elapsed_fin sock mess H) := do
    midx ← incoming.messages.check_member (sock.value, mess),
    some (lookup_updatef a_ip (λ inc, {inc with messages := list.remove_member _ midx}))

def next_agent_state_from_dlabel
  : ∀ {a_next : act ag.state_type} (la : dlabel a_next)
  , option (ag.state_type × (global_state_t → global_state_t))
| (act.poll ports sockets bound cont) (dlabel.poll ._ ._ ._ ._ r) := do
    updatef ← next_agent_state_poll_dlabel cont r,
    let (ms, new_state) := cont r,
    some (new_state, apply_message_updates ms updatef)

end

def next_state_from_dlabel (system : system_state)
  : sys_dlabel system → option system_state
| (sys_dlabel.mk ag aupdate) :=
  option.bind (next_agent_state_from_dlabel ag.key ag.value
     (system.global_state ag.key) aupdate)
     $ λ p, let (new_state, updatef) := p in
   some  { local_state  := lookup_update ag new_state system.local_state
        , global_state := updatef system.global_state }

open temporal

-- Our labeled transition system
def LTSd (s : system_state) (l : sys_dlabel s) (s' : system_state) : Prop :=
  next_state_from_dlabel s l = some s'

def TR := trace (sigma sys_dlabel)
def TP := tProp (sigma sys_dlabel)

/--
Apply a function (usually a predicate) to the label of a state-label pair
-/
def inLabel {S} {L} {B} (f : L → B) (x : sigma (λ _ : S, L)) : B := f x.snd
/--
If we apply a decidable prop to the label, that application is decidable
-/
instance inLabel_decidable {S L} {P : L → Prop} [decP : decidable_pred P] :
  decidable_pred (@inLabel S L _ P) :=
begin
intros x, apply decP,
end

lemma inLabel_mono {S} {L} : subset.monotone (@inLabel S L Prop)
:= begin
intros P Q PQ x Hx, apply PQ, apply Hx
end

end

end network


import Structure.Generic.Axioms.Universes
import Structure.Generic.Axioms.AbstractFunctors

import mathlib4_experiments.Data.Equiv.Basic

set_option autoBoundImplicitLocal false
--set_option pp.universes true

universes u v

class HasExternalEquivalences (U : Universe.{u}) (V : Universe.{v})
                              [hUV : HasExternalFunctors U V] [hVU : HasExternalFunctors V U] : Type (max u v) where
(IsEquiv {α : U} {β : V} : (α ⟶' β) → (β ⟶' α) → Sort (max u v))

structure BundledEquivalence {U : Universe.{u}} {V : Universe.{v}}
                             [hUV : HasExternalFunctors U V] [hVU : HasExternalFunctors V U]
                             [h : HasExternalEquivalences U V]
                             (α : U) (β : V) : Sort (max 1 u v) where
(toFun   : α ⟶' β)
(invFun  : β ⟶' α)
(isEquiv : h.IsEquiv toFun invFun)

namespace BundledEquivalence

  infix:20 " ⟷' " => BundledEquivalence

  variable {U V : Universe} [hUV : HasExternalFunctors U V] [hVU : HasExternalFunctors V U]
           [h : HasExternalEquivalences U V]

  def mkEquiv {α : U} {β : V} {to : α ⟶' β} {inv : β ⟶' α} (he : h.IsEquiv to inv) : α ⟷' β :=
  ⟨to, inv, he⟩

end BundledEquivalence

class HasInternalEquivalences (U : Universe.{u}) [h : HasInternalFunctors U] extends HasExternalEquivalences U U : Type u where
(Equiv                          : U → U → U)
(equivEquiv           (α β : U) : ⌈Equiv α β⌉ ≃ (α ⟷' β))
(equivElimToFunIsFun  (α β : U) : h.IsFun (λ E : Equiv α β => HasInternalFunctors.fromBundled ((equivEquiv α β).toFun E).toFun))
(equivElimInvFunIsFun (α β : U) : h.IsFun (λ E : Equiv α β => HasInternalFunctors.fromBundled ((equivEquiv α β).toFun E).invFun))

namespace HasInternalEquivalences

  infix:20 " ⟷ " => HasInternalEquivalences.Equiv

  variable {U : Universe} [HasInternalFunctors U] [h : HasInternalEquivalences U]

  def toBundled   {α β : U} (E : α ⟷  β) : α ⟷' β := (h.equivEquiv α β).toFun  E
  def fromBundled {α β : U} (E : α ⟷' β) : α ⟷  β := (h.equivEquiv α β).invFun E

  @[simp] theorem fromToBundled {α β : U} (E : α ⟷  β) : fromBundled (toBundled E) = E :=
  (h.equivEquiv α β).leftInv  E
  @[simp] theorem toFromBundled {α β : U} (E : α ⟷' β) : toBundled (fromBundled E) = E :=
  (h.equivEquiv α β).rightInv E

  def to  {α β : U} (E : α ⟷ β) (a : α) : β := (toBundled E).toFun  a
  def inv {α β : U} (E : α ⟷ β) (b : β) : α := (toBundled E).invFun b

  def toFun  {α β : U} (E : α ⟷ β) : α ⟶ β := HasInternalFunctors.fromBundled (toBundled E).toFun
  def invFun {α β : U} (E : α ⟷ β) : β ⟶ α := HasInternalFunctors.fromBundled (toBundled E).invFun

  @[simp] theorem toFun.eff  {α β : U} (E : α ⟷ β) (a : α) : (toFun  E) a = to  E a :=
  by apply HasInternalFunctors.fromBundled.eff
  @[simp] theorem invFun.eff {α β : U} (E : α ⟷ β) (b : β) : (invFun E) b = inv E b :=
  by apply HasInternalFunctors.fromBundled.eff

  def toFunFun'  (α β : U) : (α ⟷ β) ⟶' (α ⟶ β) := BundledFunctor.mkFun (h.equivElimToFunIsFun  α β)
  def invFunFun' (α β : U) : (α ⟷ β) ⟶' (β ⟶ α) := BundledFunctor.mkFun (h.equivElimInvFunIsFun α β)
  def toFunFun   (α β : U) : (α ⟷ β) ⟶  (α ⟶ β) := HasInternalFunctors.fromBundled (toFunFun'  α β)
  def invFunFun  (α β : U) : (α ⟷ β) ⟶  (β ⟶ α) := HasInternalFunctors.fromBundled (invFunFun' α β)

  @[simp] theorem toFunFun.eff  {α β : U} (E : α ⟷ β) : (toFunFun  α β) E = toFun  E :=
  by apply HasInternalFunctors.fromBundled.eff
  @[simp] theorem invFunFun.eff {α β : U} (E : α ⟷ β) : (invFunFun α β) E = invFun E :=
  by apply HasInternalFunctors.fromBundled.eff
  @[simp] theorem toFunFun.effEff  {α β : U} (E : α ⟷ β) (a : α) : ((toFunFun  α β) E) a = to  E a :=
  by simp
  @[simp] theorem invFunFun.effEff {α β : U} (E : α ⟷ β) (b : β) : ((invFunFun α β) E) b = inv E b :=
  by simp

  @[simp] theorem toFun.bundledEq  {α β : U} (E : α ⟷ β) : HasInternalFunctors.toBundled (toFun E)  = (toBundled E).toFun :=
  HasInternalFunctors.toFromBundled (toBundled E).toFun
  @[simp] theorem invFun.bundledEq {α β : U} (E : α ⟷ β) : HasInternalFunctors.toBundled (invFun E) = (toBundled E).invFun :=
  HasInternalFunctors.toFromBundled (toBundled E).invFun

  def isEquiv {α β : U} (E : α ⟷ β) : h.IsEquiv (toBundled E).toFun (toBundled E).invFun :=
  (toBundled E).isEquiv

  def isEquiv' {α β : U} (E : α ⟷ β) :
    h.IsEquiv (HasInternalFunctors.toBundled (toFun E)) (HasInternalFunctors.toBundled (invFun E)) :=
  by simp; apply isEquiv

  @[simp] theorem fromBundled.to.coe'  {α β : U} (E : α ⟷' β) : (toBundled (fromBundled E)).toFun  = E.toFun  :=
  congrArg BundledEquivalence.toFun  (toFromBundled E)
  @[simp] theorem fromBundled.inv.coe' {α β : U} (E : α ⟷' β) : (toBundled (fromBundled E)).invFun = E.invFun :=
  congrArg BundledEquivalence.invFun (toFromBundled E)
  @[simp] theorem fromBundled.to.coe  {α β : U} (E : α ⟷' β) : (toBundled (fromBundled E)).toFun.f  = E.toFun.f  :=
  congrArg BundledFunctor.f (fromBundled.to.coe'  E)
  @[simp] theorem fromBundled.inv.coe {α β : U} (E : α ⟷' β) : (toBundled (fromBundled E)).invFun.f = E.invFun.f :=
  congrArg BundledFunctor.f (fromBundled.inv.coe' E)
  @[simp] theorem fromBundled.to.eff  {α β : U} (E : α ⟷' β) (a : α) : to  (fromBundled E) a = E.toFun  a :=
  congrFun (fromBundled.to.coe  E) a
  @[simp] theorem fromBundled.inv.eff {α β : U} (E : α ⟷' β) (b : β) : inv (fromBundled E) b = E.invFun b :=
  congrFun (fromBundled.inv.coe E) b

  def mkEquiv {α β : U} {to : α ⟶' β} {inv : β ⟶' α} (he : h.IsEquiv to inv) : α ⟷ β :=
  fromBundled (BundledEquivalence.mkEquiv he)

end HasInternalEquivalences

class HasIdEquiv (U : Universe) [HasExternalFunctors U U] [HasIdFun U] [h : HasExternalEquivalences U U] where
(idIsEquiv (α : U) : h.IsEquiv (HasIdFun.idFun' α) (HasIdFun.idFun' α))

namespace HasIdEquiv

  variable {U : Universe} [HasExternalFunctors U U] [HasIdFun U] [HasExternalEquivalences U U] [h : HasIdEquiv U]

  def idEquiv' (α : U) : α ⟷' α := BundledEquivalence.mkEquiv (h.idIsEquiv α)

end HasIdEquiv

class HasCompEquiv (U V W : Universe)
                   [HasExternalFunctors U V] [HasExternalFunctors V W] [HasExternalFunctors U W]
                   [HasExternalFunctors V U] [HasExternalFunctors W V] [HasExternalFunctors W U]
                   [HasCompFun U V W] [HasCompFun W V U]
                   [HasExternalEquivalences U V] [HasExternalEquivalences V W] [h : HasExternalEquivalences U W] where
(compIsEquiv {α : U} {β : V} {γ : W} (E : α ⟷' β) (F : β ⟷' γ) : h.IsEquiv (F.toFun ⊙' E.toFun) (E.invFun ⊙' F.invFun))

namespace HasCompEquiv

  variable {U V W : Universe} [HasExternalFunctors U V] [HasExternalFunctors V W] [HasExternalFunctors U W]
           [HasExternalFunctors V U] [HasExternalFunctors W V] [HasExternalFunctors W U]
           [HasCompFun U V W] [HasCompFun W V U]
           [HasExternalEquivalences U V] [HasExternalEquivalences V W] [HasExternalEquivalences U W]
           [h : HasCompEquiv U V W]

  def compEquiv' {α : U} {β : V} {γ : W} (E : α ⟷' β) (F : β ⟷' γ) : α ⟷' γ := BundledEquivalence.mkEquiv (h.compIsEquiv E F)

end HasCompEquiv

class HasInvEquiv (U V : Universe) [HasExternalFunctors U V] [HasExternalFunctors V U]
                  [HasExternalEquivalences U V] [h : HasExternalEquivalences V U] where
(invIsEquiv {α : U} {β : V} (E : α ⟷' β) : h.IsEquiv E.invFun E.toFun)

namespace HasInvEquiv

  variable {U V : Universe} [HasExternalFunctors U V] [HasExternalFunctors V U]
           [HasExternalEquivalences U V] [HasExternalEquivalences V U] [h : HasInvEquiv U V]

  def invEquiv' {α : U} {β : V} (E : α ⟷' β) : β ⟷' α := BundledEquivalence.mkEquiv (h.invIsEquiv E)

end HasInvEquiv

class HasEquivOp (U : Universe.{u}) [h : HasInternalFunctors U] [HasLinearFunOp U] extends
  HasInternalEquivalences U, HasIdEquiv U, HasCompEquiv U U U, HasInvEquiv U U : Type u where
(compEquivIsFun    {α β : U} (E : α ⟷' β) (γ : U) : h.IsFun (λ F : β ⟷ γ => HasInternalEquivalences.mkEquiv (compIsEquiv E (HasInternalEquivalences.toBundled F))))
(compEquivFunIsFun (α β γ : U)                    : h.IsFun (λ E : α ⟷ β => HasInternalFunctors.mkFun (compEquivIsFun (HasInternalEquivalences.toBundled E) γ)))
(invEquivIsFun     (α β : U)                      : h.IsFun (λ E : α ⟷ β => HasInternalEquivalences.mkEquiv (invIsEquiv (HasInternalEquivalences.toBundled E))))
(invEquivIsEquiv   (α β : U)                      : IsEquiv (BundledFunctor.mkFun (invEquivIsFun α β)) (BundledFunctor.mkFun (invEquivIsFun β α)))

namespace HasEquivOp

  variable {U : Universe.{u}} [HasInternalFunctors U] [HasLinearFunOp U] [h : HasEquivOp U]

  def idEquiv' (α : U) : α ⟷' α := HasIdEquiv.idEquiv' α
  def idEquiv  (α : U) : α ⟷  α := HasInternalEquivalences.fromBundled (idEquiv' α)

  @[simp] theorem idEquiv.to.eff  (α : U) (a : α) : HasInternalEquivalences.to  (idEquiv α) a = a :=
  by apply HasInternalEquivalences.fromBundled.to.eff
  @[simp] theorem idEquiv.inv.eff (α : U) (a : α) : HasInternalEquivalences.inv (idEquiv α) a = a :=
  by apply HasInternalEquivalences.fromBundled.inv.eff

  def compEquiv' {α β γ : U} (E : α ⟷' β) (F : β ⟷' γ) : α ⟷' γ := HasCompEquiv.compEquiv' E F
  def compEquiv  {α β γ : U} (E : α ⟷  β) (F : β ⟷  γ) : α ⟷  γ :=
  HasInternalEquivalences.fromBundled (compEquiv' (HasInternalEquivalences.toBundled E) (HasInternalEquivalences.toBundled F))

  @[simp] theorem compEquiv.to.eff  {α β γ : U} (E : α ⟷ β) (F : β ⟷ γ) (a : α) :
    HasInternalEquivalences.to  (compEquiv E F) a = HasInternalEquivalences.to  F (HasInternalEquivalences.to  E a) :=
  by apply HasInternalEquivalences.fromBundled.to.eff
  @[simp] theorem compEquiv.inv.eff {α β γ : U} (E : α ⟷ β) (F : β ⟷ γ) (c : γ) :
    HasInternalEquivalences.inv (compEquiv E F) c = HasInternalEquivalences.inv E (HasInternalEquivalences.inv F c) :=
  by apply HasInternalEquivalences.fromBundled.inv.eff

  def compEquivFun' {α β : U} (E : α ⟷' β) (γ : U) : (β ⟷ γ) ⟶' (α ⟷ γ) := BundledFunctor.mkFun (h.compEquivIsFun E γ)
  def compEquivFun  {α β : U} (E : α ⟷  β) (γ : U) : (β ⟷ γ) ⟶  (α ⟷ γ) :=
  HasInternalFunctors.fromBundled (compEquivFun' (HasInternalEquivalences.toBundled E) γ)

  @[simp] theorem compEquivFun.eff {α β : U} (E : α ⟷ β) (γ : U) (F : β ⟷ γ) : (compEquivFun E γ) F = compEquiv E F :=
  by apply HasInternalFunctors.fromBundled.eff
  @[simp] theorem compEquivFun.to.effEff  {α β : U} (E : α ⟷ β) (γ : U) (F : β ⟷ γ) (a : α) :
    HasInternalEquivalences.to  ((compEquivFun E γ) F) a = HasInternalEquivalences.to  F (HasInternalEquivalences.to  E a) :=
  by simp
  @[simp] theorem compEquivFun.inv.effEff {α β : U} (E : α ⟷ β) (γ : U) (F : β ⟷ γ) (c : γ) :
    HasInternalEquivalences.inv ((compEquivFun E γ) F) c = HasInternalEquivalences.inv E (HasInternalEquivalences.inv F c) :=
  by simp

  def compEquivFunFun' (α β γ : U) : (α ⟷ β) ⟶' (β ⟷ γ) ⟶ (α ⟷ γ) := BundledFunctor.mkFun (h.compEquivFunIsFun α β γ)
  def compEquivFunFun  (α β γ : U) : (α ⟷ β) ⟶  (β ⟷ γ) ⟶ (α ⟷ γ) := HasInternalFunctors.fromBundled (compEquivFunFun' α β γ)

  @[simp] theorem compEquivFunFun.eff (α β γ : U) (E : α ⟷ β) : (compEquivFunFun α β γ) E = compEquivFun E γ :=
  by apply HasInternalFunctors.fromBundled.eff
  @[simp] theorem compEquivFunFun.effEff (α β γ : U) (E : α ⟷ β) (F : β ⟷ γ) : ((compEquivFunFun α β γ) E) F = compEquiv E F :=
  by simp
  @[simp] theorem compEquivFunFun.to.effEffEff  (α β γ : U) (E : α ⟷ β) (F : β ⟷ γ) (a : α) :
    HasInternalEquivalences.to  (((compEquivFunFun α β γ) E) F) a = HasInternalEquivalences.to  F (HasInternalEquivalences.to  E a) := by simp
  @[simp] theorem compEquivFunFun.inv.effEffEff (α β γ : U) (E : α ⟷ β) (F : β ⟷ γ) (c : γ) :
    HasInternalEquivalences.inv (((compEquivFunFun α β γ) E) F) c = HasInternalEquivalences.inv E (HasInternalEquivalences.inv F c) := by simp

  def invEquiv' {α β : U} (E : α ⟷' β) : β ⟷' α := HasInvEquiv.invEquiv' E
  def invEquiv  {α β : U} (E : α ⟷  β) : β ⟷  α :=
  HasInternalEquivalences.fromBundled (invEquiv' (HasInternalEquivalences.toBundled E))

  @[simp] theorem invEquiv.to.eff  {α β : U} (E : α ⟷ β) (b : β) : HasInternalEquivalences.to  (invEquiv E) b = HasInternalEquivalences.inv E b :=
  by apply HasInternalEquivalences.fromBundled.to.eff
  @[simp] theorem invEquiv.inv.eff {α β : U} (E : α ⟷ β) (a : α) : HasInternalEquivalences.inv (invEquiv E) a = HasInternalEquivalences.to  E a :=
  by apply HasInternalEquivalences.fromBundled.inv.eff

  def invEquivFun' (α β : U) : (α ⟷ β) ⟶' (β ⟷ α) := BundledFunctor.mkFun (h.invEquivIsFun α β)
  def invEquivFun  (α β : U) : (α ⟷ β) ⟶  (β ⟷ α) := HasInternalFunctors.fromBundled (invEquivFun' α β)

  @[simp] theorem invEquivFun.eff (α β : U) (E : α ⟷ β) : (invEquivFun α β) E = invEquiv E :=
  by apply HasInternalFunctors.fromBundled.eff
  @[simp] theorem invEquivFun.to.effEff  (α β : U) (E : α ⟷ β) (b : β) :
    HasInternalEquivalences.to  ((invEquivFun α β) E) b = HasInternalEquivalences.inv E b := by simp
  @[simp] theorem invEquivFun.inv.effEff (α β : U) (E : α ⟷ β) (a : α) :
    HasInternalEquivalences.inv ((invEquivFun α β) E) a = HasInternalEquivalences.to  E a := by simp

  def invEquivEquiv' (α β : U) : (α ⟷ β) ⟷' (β ⟷ α) := BundledEquivalence.mkEquiv (h.invEquivIsEquiv α β)
  def invEquivEquiv  (α β : U) : (α ⟷ β) ⟷  (β ⟷ α) := HasInternalEquivalences.fromBundled (invEquivEquiv' α β)

  @[simp] theorem invEquivEquiv.to.eff  (α β : U) (E : α ⟷ β) : HasInternalEquivalences.to  (invEquivEquiv α β) E = invEquiv E :=
  by apply HasInternalEquivalences.fromBundled.to.eff
  @[simp] theorem invEquivEquiv.inv.eff (α β : U) (E : β ⟷ α) : HasInternalEquivalences.inv (invEquivEquiv α β) E = invEquiv E :=
  by apply HasInternalEquivalences.fromBundled.inv.eff
  @[simp] theorem invEquivEquiv.to.to.effEff   (α β : U) (E : α ⟷ β) (b : β) :
    HasInternalEquivalences.to  (HasInternalEquivalences.to  (invEquivEquiv α β) E) b = HasInternalEquivalences.inv E b := by simp
  @[simp] theorem invEquivEquiv.to.inv.effEff  (α β : U) (E : α ⟷ β) (a : α) :
    HasInternalEquivalences.inv (HasInternalEquivalences.to  (invEquivEquiv α β) E) a = HasInternalEquivalences.to  E a := by simp
  @[simp] theorem invEquivEquiv.inv.to.effEff  (α β : U) (E : β ⟷ α) (a : α) :
    HasInternalEquivalences.to  (HasInternalEquivalences.inv (invEquivEquiv α β) E) a = HasInternalEquivalences.inv E a := by simp
  @[simp] theorem invEquivEquiv.inv.inv.effEff (α β : U) (E : β ⟷ α) (b : β) :
    HasInternalEquivalences.inv (HasInternalEquivalences.inv (invEquivEquiv α β) E) b = HasInternalEquivalences.to  E b := by simp

end HasEquivOp


@[simp] lemma to_bool_true_eq_tt (h : decidable true) : @to_bool true h = tt :=
decidable.cases_on h (λ h, false.elim (iff.mp not_true h)) (λ _, rfl)

@[simp] lemma to_bool_false_eq_ff (h : decidable false) : @to_bool false h = ff :=
decidable.cases_on h (λ h, rfl) (λ h, false.elim h)


definition {u v} transport {A : Type u} { P : A → Type v} {x y : A} (p : x = y)
(u : P x) : P y :=
by induction p; exact u

definition {u v w} apdt011
  {A : Type u} {Z : Type w}
  {B : A → Type v}
  (f : Πa, B a → Z)
  {a a' : A}
  {b : B a}
  {b' : B a'}
  (Ha : a = a')
  (Hb : transport Ha b = b')
      : f a b = f a' b' :=
by cases Ha; cases Hb; reflexivity

set_option trace.check true

-- set_option pp.implicit true

-- @NaturalTransformation.components ?M_1 ?M_2 ?M_3 ?M_4 :
--   @NaturalTransformation ?M_1 ?M_2 ?M_3 ?M_4 → Π (X : ?M_1.Obj), ?M_2.Hom (⇑?M_3 X) (⇑?M_4 X)

-- α === Type (max u v)
-- a === (@NaturalTransformation (C × C) C (@MonoidalStructure.tensor C m)
--           (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C)
--              (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))))
-- T === (λ (_x : Type (max u v)), _x)
-- t : T a == a
-- t === (@vertical_composition_of_NaturalTransformations (C × C) C (@MonoidalStructure.tensor C m)
--           (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
--           (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C)
--              (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m)))
--           (@isomorphism.Isomorphism.morphism (FunctorCategory (C × C) C) (@MonoidalStructure.tensor C m)
--              (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
--              (@braided_monoidal_category.Symmetry.braiding C m β))
--           (@whisker_on_left (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m)
--              (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
--              (@isomorphism.Isomorphism.morphism (FunctorCategory (C × C) C) (@MonoidalStructure.tensor C m)
--                 (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
--                 (@braided_monoidal_category.Symmetry.braiding C m β))))
-- b === (@NaturalTransformation (C × C) C (@MonoidalStructure.tensor C m) (@MonoidalStructure.tensor C m))
-- e : a = b

-- @eq.rec α a T t b e : T b
-- T b == b

-- now we want to apply
--   f === @NaturalTransformation.components (C × C) C (@MonoidalStructure.tensor C m) (@MonoidalStructure.tensor C m)
-- to @eq.rec α a T b e.
-- actually, we're going to need to think of this as applying
--   f' === @NaturalTransformation.components (C × C) C (@MonoidalStructure.tensor C m)
--      : Π (F : Functor (C × C) C), NaturalTransformation m.tensor F → Π (x : (C × C).Obj), C.Hom (m.tensor x) (F x)
-- and here we may as well introduce S : Functor (C × C) C → Type as S F = Π (x : (C × C).Obj), C.Hom (m.tensor x) (F x),
-- and then write f' : Π (F : Functor (C × C) C), NaturalTransformation m.tensor F → S F
--
-- Thus we want to start with f' (@MonoidalStructure.tensor C m) (@eq.rec α a T t b e) : S (@MonoidalStructure.tensor C m)
-- and by application of the lemma we're designing obtain ...?
--   f' (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C)
--              (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m)))
--      a
-- Now this thing is of type S (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C)
--              (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m)))
-- which is no good, so we're going to have to transport it through the type family S. But where do we obtain our
-- path/equation to transport along? Somehow we take e : a = b, and think of that actually as e : R a' = R b' ... nope.

-------------

-- 20170508
--
-- (@NaturalTransformation.components (C × C) C
--        (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
--        (@MonoidalStructure.tensor C m)
--        (@eq.rec (Functor (C × C) C)
--           (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C)) (@MonoidalStructure.tensor C m))
--           (@NaturalTransformation (C × C) C
--              (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m)))
--           (t : NaturalTransformation (switch tensor) (id tensor))
--           (@MonoidalStructure.tensor C m)
--           (FunctorComposition.left_identity (C × C) C (@MonoidalStructure.tensor C m)))
--        X)

-- S = (@NaturalTransformation (C × C) C
-- f = @NaturalTransformation.components (C × C) C
-- f : Π a a' : A, Π t : S a a', Z a a'

-- Z a a' = Π X : (C × C).Obj, C.Hom (a X) (a' X)

-- a  = (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
-- a' = (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C)) (@MonoidalStructure.tensor C m))

-- A = (Functor (C × C) C)
-- a a' : A

-- b = (@MonoidalStructure.tensor C m)
-- b : A

-- p : a' = b

-- t : S a a'

-- (@eq.rec A a' (S a) t b p) : S a b
-- f a b (@eq.rec A a' (S a) t b p) : Z a b
-- f a a' t : Z a a'
-- (@eq.rec A a' (Z a) (f a a' t) b p) : Z a b

lemma {u1 u2 u3 u4} v2 { α : Type u1 } { β : Type u2 } { S : α → β → Type u3 } { Z : α → β → Type u4 } { a : α } { b : β } { t : S a b } { b' : β } { p : b = b' } ( f : Π ( c : α ) ( d : β ) , S c d → Z c d ):
  f a b' (@eq.rec β b (S a) t b' p) = (@eq.rec β b (Z a) (f a b t) b' p) :=
begin
induction p, reflexivity
end

lemma {u1 u2 u3} v1 { β : Type u1 } { S : β → Type u2 } { Z : β → Type u3 } { b : β } { t : S b } { b' : β } { p : b = b' } ( f : Π d : β, S d → Z d ) :
  f b' (@eq.rec β b S t b' p) = (@eq.rec β b Z (f b t) b' p) :=
begin
induction p, reflexivity
end

      --  (@NaturalTransformation.components (C × C) C
      --     (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
      --     (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C)) (@MonoidalStructure.tensor C m))
      --     (@eq.rec (Functor (C × C) (C × C))
      --        (@FunctorComposition (C × C) (C × C) (C × C) (SwitchProductCategory C C) (SwitchProductCategory C C))
      --        (λ (a : Functor (C × C) (C × C)),
      --           @NaturalTransformation (C × C) C
      --             (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
      --             (@FunctorComposition (C × C) (C × C) C a (@MonoidalStructure.tensor C m)))
      --        (t : NaturalTransformation (switch tensor) (switch switch tensor))
      --        (IdentityFunctor (C × C))
      --        (switch_twice_is_the_identity C C)))

-- f  = @NaturalTransformation.components (C × C) C
-- α  = Functor (C × C) C
-- a  : α
-- a  = (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
-- β  = Functor (C × C) C
-- f  : Π (a : α) (b : β), S a b → Z a b
-- γ  = (Functor (C × C) (C × C)
-- g  = switch switch
-- g' = id
-- p  : g = g'
-- R  : γ → β
--    = λ g, (g tensor)
-- S  = λ a b, NaturalTransformation a b
--
-- f a (R g') (@eq.rec γ g (S a) t g' p)

-- c' = (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C)) (@MonoidalStructure.tensor C m))
-- c'' = (@FunctorComposition (C × C) (C × C) C (@FunctorComposition (C × C) (C × C) (C × C) (SwitchProductCategory C C) (SwitchProductCategory C C)) (@MonoidalStructure.tensor C m))
-- eq.rec ... : NaturalTransformation c c'
-- γ = (Functor (C × C) (C × C)
-- g = switch switch
-- S = Π (a : α) (g : γ), NaturalTransformation a (R g)
-- t : NaturalTransformation a (R g)
-- t : S a g
-- g' = Identity (C × C)
-- p : g = g'

-- c' = R g'
-- c'' = R g
-- R = Π g : γ, (g tensor)
-- R : γ → β

-- f a c' t' : Z a c'

-- f a (R g') (@eq.rec γ g S t g' p)
-- f a (@eq.rec γ g R c'' g' p) (@eq.rec γ g S t g' p)
-- @eq.rec γ g (Z a (R g)) (f a (R g) t) g' p
-- @eq.rec γ g (Z a ???) (f a (@eq.rec γ g' R c' g (eq.symm p)) t) g' p

lemma {u1 u2 u3 u4 u5} w
  { α : Type u1 } { β : Type u2 } { γ : Type u3 }
  { S : α → β → Type u4 }
  { Z : α → β → Type u5 }
  { a : α } { g : γ } ( R : γ → β ) { t : S a (R g) } { g' : γ } { p : g = g' } ( f : Π (a : α) (b : β), S a b → Z a b ):
  f a (R g') (@eq.rec γ g (λ g, S a (R g)) t g' p)
    =
  @eq.rec γ g (λ g, Z a (R g)) (f a (R g) t) g' p
    := begin induction p, reflexivity end

--
-- (@eq.rec (Functor (C × C) C)
--                 (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C)) (@MonoidalStructure.tensor C m))
--                 (λ (G : Functor (C × C) C),
--                    Π (X : (C × C).Obj),
--                      C.Hom
--                        (@Functor.onObjects (C × C) C
--                           (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C))
--                              (@MonoidalStructure.tensor C m))
--                           X)
--                        (@Functor.onObjects (C × C) C G X))
--                 (λ (X : (C × C).Obj),
--                    C.identity
--                      (@Functor.onObjects (C × C) C
--                         (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C))
--                            (@MonoidalStructure.tensor C m))
--                         X))
--                 (@MonoidalStructure.tensor C m)
--                 (@squared_Braiding._proof_3 C m)
--                 X)
lemma {u1 u2 u3} b { α : Type u1 } { a : α } { β : Type u2 } { Z : α → β → Type u3 } { t : Π (b : β), Z a b } { a' : α } { p : a = a' }
  : @eq.rec α a _ t a' p = λ b : β, @eq.rec α a (λ _a, Z _a b) (t b) a' p :=
begin
  induction p,
  reflexivity
end

--  (@eq.rec (Functor (C × C) C)
--                 (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C)) (@MonoidalStructure.tensor C m))
--                 (λ (_a : Functor (C × C) C),
--                    C.Hom
--                      (@Functor.onObjects (C × C) C
--                         (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C))
--                            (@MonoidalStructure.tensor C m))
--                         (X_1, X_2))
--                      (@Functor.onObjects (C × C) C _a (X_1, X_2)))
--                 (C.identity
--                    (@Functor.onObjects (C × C) C
--                       (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C))
--                          (@MonoidalStructure.tensor C m))
--                       (X_1, X_2)))
--                 (@MonoidalStructure.tensor C m)
--                 (@squared_Braiding._proof_3 C m))
-- α = (Functor (C × C) C)
-- a = (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C)) (@MonoidalStructure.tensor C m))
-- f = C.identity
--   : Π X : C.Obj, C.Hom X X
-- r = @Functor.onObjects (C × C) C
-- x : (C × C).Obj
-- r a x : C.Obj
-- t = f (r a x)
--   : C.Hom (r a x) (r a x)

lemma {u1 u2 u3 u4} pull_function_out
  { α : Type u1 } { a : α } { β : Type u2 } { Z : β → Type u3 } { γ : Type u4 } { r : Π a : α, γ → β } { x : γ } { a' : α } { p : a = a' } ( f : Π (b : β), Z b ) :
  @eq.rec α a _ (f (r a x)) a' p = f (r a' x) :=
begin
induction p, reflexivity
end

-- This seems sensible, but applies too often.
lemma {u} bar { α : Type u } { a : α } { b : α } ( p : a = b ) : @eq.rec α a (λ b: α, b = a) (eq.refl a) b p = eq.symm p :=
begin
  cases p,
  reflexivity
end

lemma {u} foo { α : Type u } { a b : α } { p : a = b } : eq.symm (eq.symm p) = p := by reflexivity

@[simp] lemma {u v w} function_of_eq.rec { α : Type u } { a : α } { T : α → Type v } { S : α → Type w } ( t : T a ) { b : α } ( e : a = b ) ( f : Π { c : α }, T c → S c ) :
  @f b ( @eq.rec α a T t b e ) = @eq.rec α a S (@f a t) b e :=
begin
  cases e,
  reflexivity
end
@[simp] lemma {u v w} function_of_eq.drec { α : Type u } { a : α } { T : Π b : α, a = b → Type v } { S : Π b : α, a = b → Type v } ( t : T a (eq.refl a)) { b : α } ( e : a = b ) ( f : Π { c : α } { p : a = c }, T c p → S c p ) :
  f ( @eq.drec α a T t b e ) = @eq.drec α a S (f t) b e :=
begin
  cases e,
  reflexivity
end

lemma z {A : Type} { X : A } : (eq.mpr (propext (eq_self_iff_true X)) trivial) = rfl :=
begin
  -- unfold trivial,
  reflexivity
end