/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.basic
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

namespace option

theorem coe_def {α : Type u_1} : coe = some := rfl

theorem some_ne_none {α : Type u_1} (x : α) : some x ≠ none :=
  fun (h : some x = none) => option.no_confusion h

@[simp] theorem get_mem {α : Type u_1} {o : Option α} (h : ↥(is_some o)) : get h ∈ o :=
  option.cases_on o
    (fun (h : ↥(is_some none)) =>
      eq.dcases_on h (fun (a : tt = false) => bool.no_confusion a) (Eq.refl tt) (HEq.refl h))
    (fun (o : α) (h : ↥(is_some (some o))) => idRhs (some o = some o) rfl) h

theorem get_of_mem {α : Type u_1} {a : α} {o : Option α} (h : ↥(is_some o)) : a ∈ o → get h = a :=
  sorry

@[simp] theorem not_mem_none {α : Type u_1} (a : α) : ¬a ∈ none :=
  fun (h : a ∈ none) => option.no_confusion h

@[simp] theorem some_get {α : Type u_1} {x : Option α} (h : ↥(is_some x)) : some (get h) = x :=
  option.cases_on x
    (fun (h : ↥(is_some none)) =>
      eq.dcases_on h (fun (a : tt = false) => bool.no_confusion a) (Eq.refl tt) (HEq.refl h))
    (fun (x : α) (h : ↥(is_some (some x))) => idRhs (some (get h) = some (get h)) rfl) h

@[simp] theorem get_some {α : Type u_1} (x : α) (h : ↥(is_some (some x))) : get h = x := rfl

@[simp] theorem get_or_else_some {α : Type u_1} (x : α) (y : α) : get_or_else (some x) y = x := rfl

@[simp] theorem get_or_else_coe {α : Type u_1} (x : α) (y : α) : get_or_else (↑x) y = x := rfl

theorem get_or_else_of_ne_none {α : Type u_1} {x : Option α} (hx : x ≠ none) (y : α) :
    some (get_or_else x y) = x :=
  sorry

theorem mem_unique {α : Type u_1} {o : Option α} {a : α} {b : α} (ha : a ∈ o) (hb : b ∈ o) :
    a = b :=
  some.inj (Eq.trans (Eq.symm ha) hb)

theorem some_injective (α : Type u_1) : function.injective some :=
  fun (_x _x_1 : α) => iff.mp some_inj

/-- `option.map f` is injective if `f` is injective. -/
theorem map_injective {α : Type u_1} {β : Type u_2} {f : α → β} (Hf : function.injective f) :
    function.injective (option.map f) :=
  sorry

theorem ext {α : Type u_1} {o₁ : Option α} {o₂ : Option α} :
    (∀ (a : α), a ∈ o₁ ↔ a ∈ o₂) → o₁ = o₂ :=
  sorry

theorem eq_none_iff_forall_not_mem {α : Type u_1} {o : Option α} : o = none ↔ ∀ (a : α), ¬a ∈ o :=
  sorry

@[simp] theorem none_bind {α : Type u_1} {β : Type u_1} (f : α → Option β) : none >>= f = none :=
  rfl

@[simp] theorem some_bind {α : Type u_1} {β : Type u_1} (a : α) (f : α → Option β) :
    some a >>= f = f a :=
  rfl

@[simp] theorem none_bind' {α : Type u_1} {β : Type u_2} (f : α → Option β) :
    option.bind none f = none :=
  rfl

@[simp] theorem some_bind' {α : Type u_1} {β : Type u_2} (a : α) (f : α → Option β) :
    option.bind (some a) f = f a :=
  rfl

@[simp] theorem bind_some {α : Type u_1} (x : Option α) : x >>= some = x := bind_pure

@[simp] theorem bind_eq_some {α : Type u_1} {β : Type u_1} {x : Option α} {f : α → Option β}
    {b : β} : x >>= f = some b ↔ ∃ (a : α), x = some a ∧ f a = some b :=
  sorry

@[simp] theorem bind_eq_some' {α : Type u_1} {β : Type u_2} {x : Option α} {f : α → Option β}
    {b : β} : option.bind x f = some b ↔ ∃ (a : α), x = some a ∧ f a = some b :=
  sorry

@[simp] theorem bind_eq_none' {α : Type u_1} {β : Type u_2} {o : Option α} {f : α → Option β} :
    option.bind o f = none ↔ ∀ (b : β) (a : α), a ∈ o → ¬b ∈ f a :=
  sorry

@[simp] theorem bind_eq_none {α : Type u_1} {β : Type u_1} {o : Option α} {f : α → Option β} :
    o >>= f = none ↔ ∀ (b : β) (a : α), a ∈ o → ¬b ∈ f a :=
  bind_eq_none'

theorem bind_comm {α : Type u_1} {β : Type u_2} {γ : Type u_3} {f : α → β → Option γ} (a : Option α)
    (b : Option β) :
    (option.bind a fun (x : α) => option.bind b (f x)) =
        option.bind b fun (y : β) => option.bind a fun (x : α) => f x y :=
  sorry

theorem bind_assoc {α : Type u_1} {β : Type u_2} {γ : Type u_3} (x : Option α) (f : α → Option β)
    (g : β → Option γ) :
    option.bind (option.bind x f) g = option.bind x fun (y : α) => option.bind (f y) g :=
  option.cases_on x (Eq.refl (option.bind (option.bind none f) g))
    fun (x : α) => Eq.refl (option.bind (option.bind (some x) f) g)

theorem join_eq_some {α : Type u_1} {x : Option (Option α)} {a : α} :
    join x = some a ↔ x = some (some a) :=
  sorry

theorem join_ne_none {α : Type u_1} {x : Option (Option α)} :
    join x ≠ none ↔ ∃ (z : α), x = some (some z) :=
  sorry

theorem join_ne_none' {α : Type u_1} {x : Option (Option α)} :
    ¬join x = none ↔ ∃ (z : α), x = some (some z) :=
  sorry

theorem bind_id_eq_join {α : Type u_1} {x : Option (Option α)} : x >>= id = join x := sorry

theorem join_eq_join {α : Type u_1} : mjoin = join := sorry

theorem bind_eq_bind {α : Type u_1} {β : Type u_1} {f : α → Option β} {x : Option α} :
    x >>= f = option.bind x f :=
  rfl

@[simp] theorem map_eq_map {α : Type u_1} {β : Type u_1} {f : α → β} :
    Functor.map f = option.map f :=
  rfl

theorem map_none {α : Type u_1} {β : Type u_1} {f : α → β} : f <$> none = none := rfl

theorem map_some {α : Type u_1} {β : Type u_1} {a : α} {f : α → β} : f <$> some a = some (f a) :=
  rfl

@[simp] theorem map_none' {α : Type u_1} {β : Type u_2} {f : α → β} : option.map f none = none :=
  rfl

@[simp] theorem map_some' {α : Type u_1} {β : Type u_2} {a : α} {f : α → β} :
    option.map f (some a) = some (f a) :=
  rfl

theorem map_eq_some {α : Type u_1} {β : Type u_1} {x : Option α} {f : α → β} {b : β} :
    f <$> x = some b ↔ ∃ (a : α), x = some a ∧ f a = b :=
  sorry

@[simp] theorem map_eq_some' {α : Type u_1} {β : Type u_2} {x : Option α} {f : α → β} {b : β} :
    option.map f x = some b ↔ ∃ (a : α), x = some a ∧ f a = b :=
  sorry

theorem map_eq_none {α : Type u_1} {β : Type u_1} {x : Option α} {f : α → β} :
    f <$> x = none ↔ x = none :=
  sorry

@[simp] theorem map_eq_none' {α : Type u_1} {β : Type u_2} {x : Option α} {f : α → β} :
    option.map f x = none ↔ x = none :=
  sorry

theorem map_congr {α : Type u_1} {β : Type u_2} {f : α → β} {g : α → β} {x : Option α}
    (h : ∀ (a : α), a ∈ x → f a = g a) : option.map f x = option.map g x :=
  sorry

@[simp] theorem map_id' {α : Type u_1} : option.map id = id := map_id

@[simp] theorem map_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} (h : β → γ) (g : α → β)
    (x : Option α) : option.map h (option.map g x) = option.map (h ∘ g) x :=
  sorry

theorem comp_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} (h : β → γ) (g : α → β)
    (x : Option α) : option.map (h ∘ g) x = option.map h (option.map g x) :=
  Eq.symm (map_map h g x)

@[simp] theorem map_comp_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : α → β) (g : β → γ) :
    option.map g ∘ option.map f = option.map (g ∘ f) :=
  sorry

theorem mem_map_of_mem {α : Type u_1} {β : Type u_2} {a : α} {x : Option α} (g : α → β)
    (h : a ∈ x) : g a ∈ option.map g x :=
  iff.mpr mem_def (Eq.symm (iff.mp mem_def h) ▸ map_some')

theorem bind_map_comm {α : Type u_1} {β : Type u_1} {x : Option (Option α)} {f : α → β} :
    x >>= option.map f = option.map (option.map f) x >>= id :=
  sorry

theorem join_map_eq_map_join {α : Type u_1} {β : Type u_2} {f : α → β} {x : Option (Option α)} :
    join (option.map (option.map f) x) = option.map f (join x) :=
  sorry

theorem join_join {α : Type u_1} {x : Option (Option (Option α))} :
    join (join x) = join (option.map join x) :=
  sorry

theorem mem_of_mem_join {α : Type u_1} {a : α} {x : Option (Option α)} (h : a ∈ join x) :
    some a ∈ x :=
  iff.mpr mem_def (Eq.symm (iff.mp mem_def h) ▸ iff.mp join_eq_some h)

@[simp] theorem pbind_eq_bind {α : Type u_1} {β : Type u_2} (f : α → Option β) (x : Option α) :
    (pbind x fun (a : α) (_x : a ∈ x) => f a) = option.bind x f :=
  sorry

theorem map_bind {α : Type u_1} {β : Type u_1} {γ : Type u_1} (f : β → γ) (x : Option α)
    (g : α → Option β) :
    option.map f (x >>= g) =
        do
          let a ← x
          option.map f (g a) :=
  sorry

theorem map_bind' {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : β → γ) (x : Option α)
    (g : α → Option β) :
    option.map f (option.bind x g) = option.bind x fun (a : α) => option.map f (g a) :=
  sorry

theorem map_pbind {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : β → γ) (x : Option α)
    (g : (a : α) → a ∈ x → Option β) :
    option.map f (pbind x g) = pbind x fun (a : α) (H : a ∈ x) => option.map f (g a H) :=
  sorry

theorem pbind_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : α → β) (x : Option α)
    (g : (b : β) → b ∈ option.map f x → Option γ) :
    pbind (option.map f x) g = pbind x fun (a : α) (h : a ∈ x) => g (f a) (mem_map_of_mem f h) :=
  option.cases_on x
    (fun (g : (b : β) → b ∈ option.map f none → Option γ) => Eq.refl (pbind (option.map f none) g))
    (fun (x : α) (g : (b : β) → b ∈ option.map f (some x) → Option γ) =>
      Eq.refl (pbind (option.map f (some x)) g))
    g

@[simp] theorem pmap_none {α : Type u_1} {β : Type u_2} {p : α → Prop} (f : (a : α) → p a → β)
    {H : ∀ (a : α), a ∈ none → p a} : pmap f none H = none :=
  rfl

@[simp] theorem pmap_some {α : Type u_1} {β : Type u_2} {p : α → Prop} (f : (a : α) → p a → β)
    {x : α} (h : p x) : pmap f (some x) = fun (_x : ∀ (a : α), a ∈ some x → p a) => some (f x h) :=
  rfl

theorem mem_pmem {α : Type u_1} {β : Type u_2} {p : α → Prop} (f : (a : α) → p a → β) (x : Option α)
    {a : α} (h : ∀ (a : α), a ∈ x → p a) (ha : a ∈ x) : f a (h a ha) ∈ pmap f x h :=
  eq.mpr (id (Eq._oldrec (Eq.refl (f a (h a ha) ∈ pmap f x h)) (propext mem_def)))
    (Eq._oldrec
      (fun (h : ∀ (a_1 : α), a_1 ∈ some a → p a_1) (ha : a ∈ some a) => Eq.refl (pmap f (some a) h))
      (Eq.symm (eq.mp (Eq._oldrec (Eq.refl (a ∈ x)) (propext mem_def)) ha)) h ha)

theorem pmap_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {p : α → Prop} (f : (a : α) → p a → β)
    (g : γ → α) (x : Option γ) (H : ∀ (a : α), a ∈ option.map g x → p a) :
    pmap f (option.map g x) H =
        pmap (fun (a : γ) (h : p (g a)) => f (g a) h) x
          fun (a : γ) (h : a ∈ x) => H (g a) (mem_map_of_mem g h) :=
  sorry

theorem map_pmap {α : Type u_1} {β : Type u_2} {γ : Type u_3} {p : α → Prop} (g : β → γ)
    (f : (a : α) → p a → β) (x : Option α) (H : ∀ (a : α), a ∈ x → p a) :
    option.map g (pmap f x H) = pmap (fun (a : α) (h : p a) => g (f a h)) x H :=
  sorry

@[simp] theorem pmap_eq_map {α : Type u_1} {β : Type u_2} (p : α → Prop) (f : α → β) (x : Option α)
    (H : ∀ (a : α), a ∈ x → p a) : pmap (fun (a : α) (_x : p a) => f a) x H = option.map f x :=
  sorry

theorem pmap_bind {α : Type u_1} {β : Type u_1} {γ : Type u_1} {x : Option α} {g : α → Option β}
    {p : β → Prop} {f : (b : β) → p b → γ} (H : ∀ (a : β), a ∈ x >>= g → p a)
    (H' : ∀ (a : α) (b : β), b ∈ g a → b ∈ x >>= g) :
    pmap f (x >>= g) H =
        do
          let a ← x
          pmap f (g a) fun (b : β) (h : b ∈ g a) => H b (H' a b h) :=
  sorry

theorem bind_pmap {α : Type u_1} {β : Type u_2} {γ : Type u_2} {p : α → Prop}
    (f : (a : α) → p a → β) (x : Option α) (g : β → Option γ) (H : ∀ (a : α), a ∈ x → p a) :
    pmap f x H >>= g = pbind x fun (a : α) (h : a ∈ x) => g (f a (H a h)) :=
  sorry

theorem pbind_eq_none {α : Type u_1} {β : Type u_2} {x : Option α} {f : (a : α) → a ∈ x → Option β}
    (h' : ∀ (a : α) (H : a ∈ x), f a H = none → x = none) : pbind x f = none ↔ x = none :=
  sorry

theorem pbind_eq_some {α : Type u_1} {β : Type u_2} {x : Option α} {f : (a : α) → a ∈ x → Option β}
    {y : β} : pbind x f = some y ↔ ∃ (z : α), ∃ (H : z ∈ x), f z H = some y :=
  sorry

@[simp] theorem pmap_eq_none_iff {α : Type u_1} {β : Type u_2} {p : α → Prop}
    {f : (a : α) → p a → β} {x : Option α} {h : ∀ (a : α), a ∈ x → p a} :
    pmap f x h = none ↔ x = none :=
  sorry

@[simp] theorem pmap_eq_some_iff {α : Type u_1} {β : Type u_2} {p : α → Prop}
    {f : (a : α) → p a → β} {x : Option α} {hf : ∀ (a : α), a ∈ x → p a} {y : β} :
    pmap f x hf = some y ↔ ∃ (a : α), ∃ (H : x = some a), f a (hf a H) = y :=
  sorry

@[simp] theorem join_pmap_eq_pmap_join {α : Type u_1} {β : Type u_2} {p : α → Prop}
    {f : (a : α) → p a → β} {x : Option (Option α)}
    (H : ∀ (a : Option α), a ∈ x → ∀ (a_1 : α), a_1 ∈ a → p a_1) :
    join (pmap (pmap f) x H) =
        pmap f (join x) fun (a : α) (h : a ∈ join x) => H (some a) (mem_of_mem_join h) a rfl :=
  sorry

@[simp] theorem seq_some {α : Type u_1} {β : Type u_1} {a : α} {f : α → β} :
    some f <*> some a = some (f a) :=
  rfl

@[simp] theorem some_orelse' {α : Type u_1} (a : α) (x : Option α) :
    option.orelse (some a) x = some a :=
  rfl

@[simp] theorem some_orelse {α : Type u_1} (a : α) (x : Option α) : (some a <|> x) = some a := rfl

@[simp] theorem none_orelse' {α : Type u_1} (x : Option α) : option.orelse none x = x :=
  option.cases_on x (Eq.refl (option.orelse none none))
    fun (x : α) => Eq.refl (option.orelse none (some x))

@[simp] theorem none_orelse {α : Type u_1} (x : Option α) : (none <|> x) = x := none_orelse' x

@[simp] theorem orelse_none' {α : Type u_1} (x : Option α) : option.orelse x none = x :=
  option.cases_on x (Eq.refl (option.orelse none none))
    fun (x : α) => Eq.refl (option.orelse (some x) none)

@[simp] theorem orelse_none {α : Type u_1} (x : Option α) : (x <|> none) = x := orelse_none' x

@[simp] theorem is_some_none {α : Type u_1} : is_some none = false := rfl

@[simp] theorem is_some_some {α : Type u_1} {a : α} : is_some (some a) = tt := rfl

theorem is_some_iff_exists {α : Type u_1} {x : Option α} : ↥(is_some x) ↔ ∃ (a : α), x = some a :=
  sorry

@[simp] theorem is_none_none {α : Type u_1} : is_none none = tt := rfl

@[simp] theorem is_none_some {α : Type u_1} {a : α} : is_none (some a) = false := rfl

@[simp] theorem not_is_some {α : Type u_1} {a : Option α} : is_some a = false ↔ is_none a = tt :=
  sorry

theorem eq_some_iff_get_eq {α : Type u_1} {o : Option α} {a : α} :
    o = some a ↔ ∃ (h : ↥(is_some o)), get h = a :=
  sorry

theorem not_is_some_iff_eq_none {α : Type u_1} {o : Option α} : ¬↥(is_some o) ↔ o = none := sorry

theorem ne_none_iff_is_some {α : Type u_1} {o : Option α} : o ≠ none ↔ ↥(is_some o) := sorry

theorem ne_none_iff_exists {α : Type u_1} {o : Option α} : o ≠ none ↔ ∃ (x : α), some x = o := sorry

theorem ne_none_iff_exists' {α : Type u_1} {o : Option α} : o ≠ none ↔ ∃ (x : α), o = some x :=
  iff.trans ne_none_iff_exists (exists_congr fun (_x : α) => eq_comm)

theorem bex_ne_none {α : Type u_1} {p : Option α → Prop} :
    (∃ (x : Option α), ∃ (H : x ≠ none), p x) ↔ ∃ (x : α), p (some x) :=
  sorry

theorem ball_ne_none {α : Type u_1} {p : Option α → Prop} :
    (∀ (x : Option α), x ≠ none → p x) ↔ ∀ (x : α), p (some x) :=
  sorry

theorem iget_mem {α : Type u_1} [Inhabited α] {o : Option α} : ↥(is_some o) → iget o ∈ o := sorry

theorem iget_of_mem {α : Type u_1} [Inhabited α] {a : α} {o : Option α} : a ∈ o → iget o = a :=
  sorry

@[simp] theorem guard_eq_some {α : Type u_1} {p : α → Prop} [decidable_pred p] {a : α} {b : α} :
    guard p a = some b ↔ a = b ∧ p a :=
  sorry

@[simp] theorem guard_eq_some' {p : Prop} [Decidable p] (u : Unit) : guard p = some u ↔ p := sorry

theorem lift_or_get_choice {α : Type u_1} {f : α → α → α} (h : ∀ (a b : α), f a b = a ∨ f a b = b)
    (o₁ : Option α) (o₂ : Option α) : lift_or_get f o₁ o₂ = o₁ ∨ lift_or_get f o₁ o₂ = o₂ :=
  sorry

@[simp] theorem lift_or_get_none_left {α : Type u_1} {f : α → α → α} {b : Option α} :
    lift_or_get f none b = b :=
  option.cases_on b (Eq.refl (lift_or_get f none none))
    fun (b : α) => Eq.refl (lift_or_get f none (some b))

@[simp] theorem lift_or_get_none_right {α : Type u_1} {f : α → α → α} {a : Option α} :
    lift_or_get f a none = a :=
  option.cases_on a (Eq.refl (lift_or_get f none none))
    fun (a : α) => Eq.refl (lift_or_get f (some a) none)

@[simp] theorem lift_or_get_some_some {α : Type u_1} {f : α → α → α} {a : α} {b : α} :
    lift_or_get f (some a) (some b) = ↑(f a b) :=
  rfl

/-- given an element of `a : option α`, a default element `b : β` and a function `α → β`, apply this
function to `a` if it comes from `α`, and return `b` otherwise. -/
def cases_on' {α : Type u_1} {β : Type u_2} : Option α → β → (α → β) → β := sorry

@[simp] theorem cases_on'_none {α : Type u_1} {β : Type u_2} (x : β) (f : α → β) :
    cases_on' none x f = x :=
  rfl

@[simp] theorem cases_on'_some {α : Type u_1} {β : Type u_2} (x : β) (f : α → β) (a : α) :
    cases_on' (some a) x f = f a :=
  rfl

@[simp] theorem cases_on'_coe {α : Type u_1} {β : Type u_2} (x : β) (f : α → β) (a : α) :
    cases_on' (↑a) x f = f a :=
  rfl

@[simp] theorem cases_on'_none_coe {α : Type u_1} {β : Type u_2} (f : Option α → β) (o : Option α) :
    cases_on' o (f none) (f ∘ coe) = f o :=
  option.cases_on o (Eq.refl (cases_on' none (f none) (f ∘ coe)))
    fun (o : α) => Eq.refl (cases_on' (some o) (f none) (f ∘ coe))

end Mathlib


import unitb.models.nondet

import util.data.option
import util.data.sum
import util.predicate

import tactic.finish

universe variables u v

open nat predicate

section

parameters (σ : Type) (lbl : Type)

@[reducible]
def pred := σ → Prop

parameters {σ}

inductive code : pred → pred → Type
  | skip {} : ∀ p, code p p
  | action : ∀ p q, set lbl → lbl → code p q
  | seq : ∀ {p q r}, code p q → code q r → code p r
  | if_then_else : ∀ p {pa pb q}, set lbl → pred → code pa q → code pb q → code p q
  | while : ∀ {p inv} q, set lbl → pred → code p inv → code inv q

parameters {σ lbl}

@[pattern,reducible]
def if_then_else : ∀ p {pa pb q}, set lbl → pred → code pa q → code pb q → code p q :=
code.if_then_else

@[pattern,reducible]
def while : ∀ {p inv} q, set lbl → pred → code p inv → code inv q :=
@code.while

inductive current : ∀ {p q}, code p q → Type
  | action : ∀ p q s l, current (code.action p q s l)
  | seq_left : ∀ p q r (c₀ : code p q) (c₁ : code q r), current c₀ → current (code.seq c₀ c₁)
  | seq_right : ∀ p q r (c₀ : code p q) (c₁ : code q r), current c₁ → current (code.seq c₀ c₁)
  | ite_cond  : ∀ p t pa pb q s (c₀ : code pa q) (c₁ : code pb q),
         current (code.if_then_else p s t c₀ c₁)
  | ite_left  : ∀ p t pa pb q s (c₀ : code pa q) (c₁ : code pb q),
         current c₀ → current (code.if_then_else p s t c₀ c₁)
  | ite_right : ∀ p t pa pb q s (c₀ : code pa q) (c₁ : code pb q),
         current c₁ → current (code.if_then_else p s t c₀ c₁)
  | while_cond : ∀ p inv q s w (c : code p inv),
         current (code.while q s w c)
  | while_body : ∀ p inv q s w (c : code p inv),
         current c → current (code.while q s w c)

@[reducible]
def seq_left {p q r} {c₀ : code p q} (c₁ : code q r)
  (cur : current c₀)
: current (code.seq c₀ c₁) :=
current.seq_left _ _ _ c₀ _ cur

@[reducible]
def seq_right {p q r} (c₀ : code p q) {c₁ : code q r}
  (cur : current c₁)
: current (code.seq c₀ c₁) :=
current.seq_right _ _ _ c₀ _ cur

@[reducible]
def ite_cond (p t) {pa pb q} (s : set lbl) (c₀ : code pa q) (c₁ : code pb q)
: current (if_then_else p s t c₀ c₁) :=
current.ite_cond p t _ _ _ s c₀ c₁

@[reducible]
def ite_left (p t) {pa pb q} (s : set lbl) {c₀ : code pa q} (c₁ : code pb q) (cur₀ : current c₀)
: current (if_then_else p s t c₀ c₁) :=
current.ite_left p t _ _ _ s c₀ c₁ cur₀

@[reducible]
def ite_right (p t : pred) {pa pb q : pred} (s : set lbl)
  (c₀ : code pa q) {c₁ : code pb q}
  (cur₁ : current c₁)
: current (if_then_else p s t c₀ c₁) :=
current.ite_right p t _ _ _ s c₀ c₁ cur₁

@[reducible]
def while_cond {p inv} (q s w) (c : code p inv)
: current (code.while q s w c) :=
current.while_cond p inv q s w c

@[reducible]
def while_body {p inv} (q s w) {c : code p inv}
  (cur : current c)
: current (code.while q s w c) :=
current.while_body p inv q s w c cur

def selects' : Π {p q} {c : code p q}, current c → lbl → Prop
  | ._ ._ ._ (current.action _ _ _ e') e := e = e'
  | ._ ._ ._ (current.seq_left _ _ _ s c p) e := selects' p e
  | ._ ._ ._ (current.seq_right _ _ _ _ _ p) e := selects' p e
  | ._ ._ ._ (current.ite_cond _ _ _ _ _ _ _ _) e    := false
  | ._ ._ ._ (current.ite_left _ _ _ _ _ _ _ _ p) e  := selects' p e
  | ._ ._ ._ (current.ite_right _ _ _ _ _ _ _ _ p) e := selects' p e
  | ._ ._ ._ (current.while_cond _ _ _ _ _ _) e   := false
  | .(inv) .(q) ._ (current.while_body p inv q _ _ _ pc) e := selects' pc e

def selects {p q} {c : code p q} : option (current c) → lbl → Prop
  | (some c) := selects' c
  | none := False

def is_control' : Π {p q} {c : code p q}, current c → bool
  | ._ ._ ._ (current.action _ _ _ l) := ff
  | ._ ._ ._ (current.seq_left  p q r _ _ pc)       := is_control' pc
  | ._ ._ ._ (current.seq_right p q r _ _ pc)       := is_control' pc
  | .(p) .(q) ._ (current.ite_cond  p t pa pb q _ _ _) := tt
  | ._ ._ ._ (current.ite_left  p t _ _ _ _ _ _ pc)    := is_control' pc
  | ._ ._ ._ (current.ite_right p t _ _ _ _ _ _ pc)    := is_control' pc
  | .(inv) .(q) ._ (current.while_cond p inv q _ t _) := tt
  | ._ ._ ._ (current.while_body _ _ _ _ _ _ pc)      := is_control' pc

def is_control {p q} {c : code p q} : option (current c) → bool
  | (some pc) := is_control' pc
  | none := ff

-- def control {p q} (c : code p q) := subtype (@is_control _ _ c)

-- instance is_control_decidable
-- : ∀ {p q} {c : code p q} (cur : current c), decidable (is_control cur)
--   | ._ ._ ._ (current.action _ _ _) := decidable.false
--   | ._ ._ ._ (current.seq_left p q r c₀ c₁ cur) := is_control_decidable cur
--   | ._ ._ ._ (current.seq_right p q r c₀ c₁ cur) := is_control_decidable cur
--   | ._ ._ ._ (current.ite_cond  p t pa pb q c₀ c₁) := decidable.true
--   | ._ ._ ._ (current.ite_left  p t pa pb q c₀ c₁ cur) := is_control_decidable cur
--   | ._ ._ ._ (current.ite_right p t pa pb q c₀ c₁ cur) := is_control_decidable cur
--   | ._ ._ ._ (current.while_cond p t inv q c) := decidable.true
--   | ._ ._ ._ (current.while_body p t inv q c cur) := is_control_decidable cur

def condition' : Π {p q} {c : code p q} (pc : current c), is_control' pc → σ → Prop
  | ._ ._ ._ (current.action _ _ _ _) h := by cases h
  | ._ ._ ._ (current.seq_left  p q r c₀ c₁ pc) h := condition' pc h
  | ._ ._ ._ (current.seq_right p q r c₀ c₁ pc) h := condition' pc h
  | .(p) .(q) ._ (current.ite_cond  p c pa pb q _ c₀ c₁) h := c
  | .(p) .(q) ._ (current.ite_left  p c pa pb q _ c₀ c₁ pc) h := condition' pc h
  | .(p) .(q) ._ (current.ite_right p c pa pb q _ c₀ c₁ pc) h := condition' pc h
  | .(inv) .(q) ._ (current.while_cond p inv q _ c _) h    := c
  | .(inv) .(q) ._ (current.while_body p inv q _ _ _ pc) h := condition' pc h

def condition {p q} {c : code p q} : ∀ pc : option $ current c, is_control pc → σ → Prop
  | (some pc) := condition' pc
  | none := assume h, by cases h

def action_of : Π {p q} {c : code p q} (cur : current c),
{ p // ∃ P, condition (some cur) P = p }  ⊕ subtype (selects (some cur))
  | ._ ._ ._ (current.action _ _ _ l) := sum.inr ⟨l,rfl⟩
  | ._ ._ ._ (current.seq_left  p q r _ _ pc) := action_of pc
  | ._ ._ ._ (current.seq_right p q r _ _ pc) := action_of pc
  | .(p) .(q) ._ (current.ite_cond  p t pa pb q _ _ _) := sum.inl ⟨t,rfl,rfl⟩
  | ._ ._ ._ (current.ite_left  p t _ _ _ _ _ _ pc) := action_of pc
  | ._ ._ ._ (current.ite_right p t _ _ _ _ _ _ pc) := action_of pc
  | .(inv) .(q) ._ (current.while_cond p inv q _ t _)    := sum.inl ⟨t,rfl,rfl⟩
  | ._ ._ ._ (current.while_body _ _ _ _ _ _ pc) := action_of pc

def assert_of' : Π {p q} {c : code p q}, current c → σ → Prop
  | .(p) ._ ._ (current.action p _ _ _) := p
  | ._ ._ ._ (current.seq_left  _ _ _ _ _ pc) := assert_of' pc
  | ._ ._ ._ (current.seq_right _ _ _ _ _ pc) := assert_of' pc
  | .(p) ._ ._ (current.ite_cond  p _ _ _ _ _ _ _)  := p
  | ._ ._ ._ (current.ite_left  _ _ _ _ _ _ _ _ pc) := assert_of' pc
  | ._ ._ ._ (current.ite_right _ _ _ _ _ _ _ _ pc) := assert_of' pc
  | .(inv) .(q) ._ (current.while_cond p inv q _ _ _)  := inv
  | ._ ._ ._ (current.while_body _ _ _ _ _ _ pc) := assert_of' pc

def assert_of {p q} {c : code p q} : option (current c) → σ → Prop
  | none := q
  | (some pc) := assert_of' pc

local attribute [instance] classical.prop_decidable

noncomputable def next_assert' : Π {p q} {c : code p q}, current c → σ → σ → Prop
  | ._ .(q) ._ (current.action _ q _ _) := λ _, q
  | ._ ._ ._ (current.seq_left  _ _ _ _ _ pc) := next_assert' pc
  | ._ ._ ._ (current.seq_right _ _ _ _ _ pc) := next_assert' pc
  | .(p) .(q) ._ (current.ite_cond  p t pa pb q _ _ _)  := λ s, if t s then pa else pb
  | ._ ._ ._ (current.ite_left  _ _ _ _ _ _ _ _ pc) := next_assert' pc
  | ._ ._ ._ (current.ite_right _ _ _ _ _ _ _ _ pc) := next_assert' pc
  | .(inv) .(q) ._ (current.while_cond p inv q _ t _)  := λ s, if t s then p else q
  | ._ ._ ._ (current.while_body _ _ _ _ _ _ pc) := next_assert' pc

noncomputable def next_assert {p q} {c : code p q} : option (current c) → σ → σ → Prop
  | none := λ _, q
  | (some pc) := next_assert' pc

def first : Π {p q} (c : code p q), option (current c)
  | ._ ._ (code.skip p) := none
  | ._ ._ (code.action p _ _ l) := some $ current.action _ _ _ _
  | .(p) .(r) (@code.seq ._ ._ p q r c₀ c₁) :=
        seq_left c₁ <$> first _
    <|> seq_right _ <$> first _
  | ._ ._ (@if_then_else ._ ._ p _ _ _ _ c b₀ b₁) :=
    some $ ite_cond _ _ _ _ _
  | ._ ._ (@code.while ._ ._ _ _ _ _ c b) :=
    some $ while_cond _ _ _ _

noncomputable def next' (s : σ) : ∀ {p q} {c : code p q}, current c → option (current c)
  | ._ ._ ._ (current.action p q _ l) := none
  | ._ ._ ._ (current.seq_left _ _ _ c₀ c₁ cur₀) :=
        seq_left c₁ <$> next' cur₀
    <|> seq_right c₀ <$> first c₁
  | ._ ._ ._ (current.seq_right _ _ _ c₀ c₁ cur₁) :=
        seq_right _ <$> next' cur₁
  | .(p) .(q) ._ (current.ite_cond p c pa pb q _ b₀ b₁) :=
      if c s
         then ite_left _ _ _ _ <$> first b₀
         else ite_right _ _ _ _ <$> first b₁
  | ._ ._ ._ (current.ite_left _ _ _ _ _ _ b₀ b₁ cur₀) :=
      ite_left _ _ _ b₁ <$> next' cur₀
  | ._ ._ ._ (current.ite_right _ _ _ _ _ _ b₀ b₁ cur₁) :=
      ite_right _ _ _ _ <$> next' cur₁
  | .(inv) .(q) ._ (current.while_cond p inv q ds c b) :=
      if c s
      then while_body q ds c <$> first b <|> some (while_cond _ ds _ b)
      else none
  | ._ ._ ._ (current.while_body _ _ q _ c b cur) :=
          while_body q _ c <$> next' cur
      <|> some (while_cond _ _ _ b)

noncomputable def next (s : σ) {p q : pred} {c : code p q}
: option (current c) → option (current c)
  | (some pc) := next' s pc
  | none := none

inductive subtree {p q : pred} (c : code p q) : ∀ {p' q' : pred}, code p' q' → Type
  | rfl {} : subtree c
  | seq_left  : ∀ (p' q' r) (c₀ : code p' q') (c₁ : code q' r),
    subtree c₀ →
    subtree (code.seq c₀ c₁)
  | seq_right : ∀ (p' q' r) (c₀ : code p' q') (c₁ : code q' r),
    subtree c₁ →
    subtree (code.seq c₀ c₁)
  | ite_left  : ∀ (ds t p' pa pb q') (c₀ : code pa q') (c₁ : code pb q'),
    subtree c₀ →
    subtree (code.if_then_else p' ds t c₀ c₁)
  | ite_right : ∀ (ds t p' pa pb q') (c₀ : code pa q') (c₁ : code pb q'),
    subtree c₁ →
    subtree (code.if_then_else p' ds t c₀ c₁)
  | while : ∀ (ds t p' q' inv) (c' : code q' inv),
    subtree c' →
    subtree (code.while p' ds t c')

set_option eqn_compiler.lemmas false
def within' {p q : pred} {c : code p q}
: ∀ {p' q'} {c' : code p' q'} (P : subtree c c') (pc : current c'), bool
  | ._ ._ ._ subtree.rfl pc := tt
  | ._ ._ ._ (subtree.seq_left p' q' r' c₀ c₁ P)
             (current.seq_left ._ ._ ._ ._ ._ pc) := within' P pc
  | ._ ._ ._ (subtree.seq_left p' q' r' c₀ c₁ P)
             (current.seq_right ._ ._ ._ ._ ._ pc) := ff
  | ._ ._ ._ (subtree.seq_right p' q' r' c₀ c₁ P)
             (current.seq_left ._ ._ ._ ._ ._ pc) := ff
  | ._ ._ ._ (subtree.seq_right p' q' r' c₀ c₁ P)
             (current.seq_right ._ ._ ._ ._ ._ pc) := within' P pc
  | ._ ._ ._ (subtree.ite_left ds t p' pa pb q' c₀ c₁ P)
             (current.ite_left ._ ._ ._ ._ ._ ._ ._ ._ pc) := within' P pc
  | ._ ._ ._ (subtree.ite_left ds t p' pa pb q' c₀ c₁ P)
             (current.ite_right ._ ._ ._ ._ ._ ._ ._ ._ pc) := ff
  | ._ ._ ._ (subtree.ite_left ds t p' pa pb q' c₀ c₁ P)
             (current.ite_cond ._ ._ ._ ._ ._ ._ ._ ._) := ff
  | ._ ._ ._ (subtree.ite_right ds t p' pa pb q' c₀ c₁ P)
             (current.ite_left ._ ._ ._ ._ ._ ._ ._ ._ pc) := ff
  | ._ ._ ._ (subtree.ite_right ds t p' pa pb q' c₀ c₁ P)
             (current.ite_right ._ ._ ._ ._ ._ ._ ._ ._ pc) := within' P pc
  | ._ ._ ._ (subtree.ite_right ds t p' pa pb q' c₀ c₁ P)
             (current.ite_cond ._ ._ ._ ._ ._ ._ ._ ._) := ff
  | ._ ._ ._ (subtree.while ds t p' q' inv c' P)
             (current.while_body ._ ._ ._ ._ ._ ._ pc) := within' P pc
  | ._ ._ ._ (subtree.while ds t p' q' inv c' P)
             (current.while_cond .(q') .(inv) .(p') .(ds) .(t) .(c')) := ff

def exit' {p q : pred} {c : code p q}
: ∀ {p' q'} {c' : code p' q'} (P : subtree c c'), option (current c')
  | ._ ._ ._ subtree.rfl := none
  | ._ ._ ._ (subtree.seq_left p' q' r' c₀ c₁ P)  :=
        (seq_left c₁ <$> exit' P)
    <|> (seq_right c₀ <$> first c₁)
  | ._ ._ ._ (subtree.seq_right p' q' r' c₀ c₁ P) :=
        seq_right c₀ <$> exit' P
  | ._ ._ ._ (subtree.ite_left  ds t p' pa pb q' c₀ c₁ P) :=
        ite_left p' t ds c₁ <$> exit' P
  | ._ ._ ._ (subtree.ite_right ds t p' pa pb q' c₀ c₁ P) :=
        ite_right p' t ds c₀ <$> exit' P
  | ._ ._ ._ (subtree.while ds t p' q' inv c' P)       :=
        (    while_body _ ds _ <$> exit' P
         <|> some (current.while_cond _ _ _ _ _ _))
set_option eqn_compiler.lemmas true

@[simp]
lemma exit'_rfl
: ∀ {p' q'} {c' : code p' q'}, exit' (subtree.rfl : subtree c' c') = none :=
by { intros, cases c' ; refl }

@[simp]
lemma exit'_seq_left {p' q' p q r : pred}
  {c : code p' q'} {c₀ : code p q} {c₁ : code q r}
  {P : subtree c c₀ }
: exit' (subtree.seq_left p q r c₀ c₁ P) =
  (     (seq_left c₁ <$> exit' P)
    <|> (seq_right c₀ <$> first c₁) ) :=
by refl

@[simp]
lemma exit'_seq_right {p' q' p q r : pred}
  {c : code p' q'} {c₀ : code p q} {c₁ : code q r}
  {P : subtree c c₁ }
: exit' (subtree.seq_right p q r c₀ c₁ P) =
  (seq_right c₀ <$> exit' P) :=
by refl

@[simp]
lemma exit'_ite_left {p' q' p pa pb q : pred}
  {ds} {t : pred}
  {c : code p' q'} {c₀ : code pa q} {c₁ : code pb q}
  {P : subtree c c₀ }
: exit' (subtree.ite_left ds t p pa pb q c₀ c₁ P) =
  ite_left p t ds c₁ <$> exit' P :=
by refl

@[simp]
lemma exit'_ite_right {p' q' p pa pb q : pred}
  {ds} {t : pred}
  {c : code p' q'} {c₀ : code pa q} {c₁ : code pb q}
  {P : subtree c c₁ }
: exit' (subtree.ite_right ds t p pa pb q c₀ c₁ P) =
  ite_right p t ds c₀ <$> exit' P :=
by refl

@[simp]
lemma exit'_while {p' q' p inv q : pred}
  {ds} {t : pred}
  {c : code p' q'} {c' : code p inv}
  {P : subtree c c' }
: exit' (subtree.while ds q t p inv c' P) =
  (    while_body t ds q <$> exit' P
   <|> some (current.while_cond _ _ _ _ _ _)) :=
by refl

@[simp]
lemma within'_rfl {p' q' : pred}
  {c : code p' q'}
  {pc : current c}
:   within' subtree.rfl pc
  ↔ true :=
by { cases c ; change tt ↔ true ; simp ; exact rfl, }

@[simp]
lemma within'_seq_left {p' q' p q r : pred}
  {c : code p' q'} {c₀ : code p q} {c₁ : code q r}
  {P : subtree c c₀ }
  {pc : current (code.seq c₀ c₁)}
:   within' (subtree.seq_left p q r c₀ c₁ P) pc
  ↔ (∃ pc₀, within' P pc₀ ∧ pc = current.seq_left p q r c₀ c₁ pc₀) :=
begin
  cases pc with pc,
  { split ; intro h,
    { existsi a,
      split, apply h, refl },
    { cases h with pc₀ h, cases h with h₀ h₁,
      rw h₁, apply h₀ }, },
  { split ; intro h,
    { cases h },
    { cases h with pc₀ h, cases h with h₀ h₁,
      cases h₁, } }
end

@[simp]
lemma within'_seq_right {p' q' p q r : pred}
  {c : code p' q'} {c₀ : code p q} {c₁ : code q r}
  {P : subtree c c₁ }
  {pc : current (code.seq c₀ c₁)}
:   within' (subtree.seq_right p q r c₀ c₁ P) pc
  ↔ (∃ pc₁, within' P pc₁ ∧ pc = current.seq_right p q r c₀ c₁ pc₁) :=
begin
  cases pc with pc,
  { split ; intro h,
    { cases h },
    { cases h with pc₀ h, cases h with h₀ h₁,
      cases h₁, } },
  { split ; intro h,
    { existsi a,
      split, apply h, refl },
    { cases h with pc₀ h, cases h with h₀ h₁,
      rw h₁, apply h₀ }, },
end

@[simp]
lemma within'_ite_left {p' q' p pa pb q : pred}
  {ds} {t : pred}
  {c : code p' q'} {c₀ : code pa q} {c₁ : code pb q}
  {P : subtree c c₀ }
  {pc : current _}
:   within' (subtree.ite_left ds t p pa pb q c₀ c₁ P) pc
  ↔ ∃ pc₀, within' P pc₀ ∧ pc = current.ite_left _ _ _ _ _ _ c₀ c₁ pc₀ :=
begin
  cases pc with pc,
  { split ; intro h,
    { cases h },
    { cases h with pc₀ h, cases h with h₀ h₁,
      cases h₁, } },
  { split ; intro h,
    { existsi a,
      split, apply h, refl },
    { cases h with pc₀ h, cases h with h₀ h₁,
      rw h₁, apply h₀ }, },
  { split ; intro h,
    { cases h },
    { cases h with pc₀ h, cases h with h₀ h₁,
      cases h₁, } }
end

@[simp]
lemma within'_ite_right {p' q' p pa pb q : pred}
  {ds} {t : pred}
  {c : code p' q'} {c₀ : code pa q} {c₁ : code pb q}
  {P : subtree c c₁ }
  {pc : current _}
:   within' (subtree.ite_right ds t p pa pb q c₀ c₁ P) pc
  ↔ ∃ pc₁, within' P pc₁ ∧ pc = current.ite_right _ _ _ _ _ _ c₀ c₁ pc₁ :=
begin
  cases pc with pc,
  { split ; intro h,
    { cases h },
    { cases h with pc₀ h, cases h with h₀ h₁,
      cases h₁, } },
  { split ; intro h,
    { cases h },
    { cases h with pc₀ h, cases h with h₀ h₁,
      cases h₁, } },
  { split ; intro h,
    { existsi a,
      split, apply h, refl },
    { cases h with pc₀ h, cases h with h₀ h₁,
      rw h₁, apply h₀ }, },
end

@[simp]
lemma within'_while {p' q' p inv q : pred}
  {ds} {t : pred}
  {c : code p' q'} {c' : code p inv}
  {P : subtree c c' }
  {pc : current _}
:   within' (subtree.while ds q t p inv c' P) pc
  ↔ ∃ pc', within' P pc' ∧ pc = current.while_body _ _ _ _ _ c' pc' :=
begin
  split ; intro h,
  { cases pc,
    { cases h },
    { existsi a, split,
      { apply h },
      { refl } } },
  { cases h with pc' h, cases h with h₀ h₁,
    cases h₁, apply h₀ }
end

def counter {p q ds l}
: ∀ {p' q'} {c' : code p' q'}, subtree (code.action p q ds l) c' → current c'
  | ._ ._ ._ subtree.rfl := current.action _ _ _ _
  | ._ ._ ._ (subtree.seq_left p q r c₀ c₁ P) :=
    current.seq_left _ _ _ _ _ (counter P)
  | ._ ._ ._ (subtree.seq_right p q r c₀ c₁ P) :=
    current.seq_right _ _ _ _ _ (counter P)
  | ._ ._ ._ (subtree.ite_left ds p t pa pb q c₀ c₁ P) :=
    current.ite_left _ _ _ _ _ _ _ _ (counter P)
  | ._ ._ ._ (subtree.ite_right ds p t pa pb q c₀ c₁ P) :=
    current.ite_right _ _ _ _ _ _ _ _ (counter P)
  | ._ ._ ._ (subtree.while p t inv q c₀ c₁ P) :=
    current.while_body _ _ _ _ _ _ (counter P)

def within {p q : pred} {c : code p q} {p' q'} {c' : code p' q'} (P : subtree c c')
: option (current c') → Prop
  | (some pc) := within' P pc ∨ exit' P = some pc
  | none := exit' P = none

def exits {p q : pred} {c : code p q} {p' q'} {c' : code p' q'} (P : subtree c c')
  (pc : option (current c')) : Prop :=
exit' P = pc

lemma within_rfl {p q : pred} {c : code p q}
  (pc : option (current c))
: within subtree.rfl pc :=
begin
  cases pc with pc,
  { dunfold within,
    cases c ; refl },
  { dunfold within,
    left, cases c ; apply rfl }
end

@[simp]
lemma within_seq_left {p' q' p q r : pred}
  {c : code p' q'} {c₀ : code p q} {c₁ : code q r}
  {P : subtree c c₀ }
  {pc : option $ current (code.seq c₀ c₁)}
:   within (subtree.seq_left p q r c₀ c₁ P) pc
  ↔ (∃ pc₀, within P pc₀ ∧ pc = current.seq_left p q r c₀ c₁ <$> pc₀) :=
begin
  cases pc with pc,
  { simp [within], split ; intro h,
    { existsi none, simp [within],
      cases h, assumption },
    { cases h with pc₀ h, cases h with h₀ h₁,
      rw [eq_comm,fmap_eq_none_iff] at h₁, subst pc₀,
      dunfold within at h₀, simp [h₀], admit } },
  { admit }
end

section projections

variables {p q r : pred}
variables {c₀ : code p q}
variables {c₁ : code q r}

def subtree.left
: ∀ {p' q'} {c : code p' q'}, subtree (code.seq c₀ c₁) c → subtree c₀ c
 | ._ ._ ._ subtree.rfl := subtree.seq_left _ _ _ _ _ subtree.rfl
 | ._ ._ ._ (subtree.seq_left p q r c₂ c₃ S) := subtree.seq_left _ _ _ _ _ (subtree.left S)
 | ._ ._ ._ (subtree.seq_right p q r c₂ c₃ S) := subtree.seq_right _ _ _ _ _ (subtree.left S)
 | ._ ._ ._ (subtree.ite_left p ds t pa pb r c₂ c₃ S) :=
   subtree.ite_left _ _ _ _ _ _ _ _ (subtree.left S)
 | ._ ._ ._ (subtree.ite_right p ds t pa pb r c₂ c₃ S) :=
   subtree.ite_right _ _ _ _ _ _ _ _ (subtree.left S)
 | ._ ._ ._ (subtree.while ds t p q c₂ c₃ S) :=
   subtree.while _ _ _ _ _ _ (subtree.left S)

def subtree.right
: ∀ {p' q'} {c : code p' q'}, subtree (code.seq c₀ c₁) c → subtree c₁ c
 | ._ ._ ._ subtree.rfl := subtree.seq_right _ _ _ _ _ subtree.rfl
 | ._ ._ ._ (subtree.seq_left p q r c₂ c₃ S) := subtree.seq_left _ _ _ _ _ (subtree.right S)
 | ._ ._ ._ (subtree.seq_right p q r c₂ c₃ S) := subtree.seq_right _ _ _ _ _ (subtree.right S)
 | ._ ._ ._ (subtree.ite_left p ds t pa pb r c₂ c₃ S) :=
   subtree.ite_left _ _ _ _ _ _ _ _ (subtree.right S)
 | ._ ._ ._ (subtree.ite_right p ds t pa pb r c₂ c₃ S) :=
   subtree.ite_right _ _ _ _ _ _ _ _ (subtree.right S)
 | ._ ._ ._ (subtree.while ds t p q c₂ c₃ S) :=
   subtree.while _ _ _ _ _ _ (subtree.right S)

variables {p' q' : pred}
variables {c : code p' q'}
variables {pc : option $ current c}

lemma within_left_or_within_right_iff_within_seq
  (H : subtree (code.seq c₀ c₁) c)
: within H pc ↔ within H.left pc ∨ within H.right pc :=
begin
  induction H,
  { cases pc with pc,
    { dunfold within subtree.left subtree.right,
      simp, },
    dunfold within subtree.left subtree.right,
    have Hnone : none = some pc ↔ false, { admit },
    simp [Hnone],
    { cases pc,
      { left,
        existsi a, refl, },
      { right, left, existsi a, refl } } },
  { cases pc with pc,
    { dsimp [within,subtree.left], admit }, dsimp [within], admit },
  all_goals { admit }
end

lemma exits_iff_exits_right
  (H : subtree (code.seq c₀ c₁) c)
: exits H pc ↔ exits H.right pc := sorry

lemma exits_left_imp_within_right
  (H : subtree (code.seq c₀ c₁) c)
: exits H.left pc → within H.right pc := sorry

end projections

end


import galois.map.fmap_func
       galois.network.labels

universes u v

namespace network

inductive act (A : Type u) : Type u
-- return a poll result and the amount of time elapsed
| poll : Π (ports : list port) (sockets : list socket) (bound : time),
     (poll_result ports sockets bound → (list (socket × message_t) × A)) → act

namespace act
def just_send_messages {A : Type u} (ms : list (socket × message_t))
  (x : A) := act.poll [] [] 0 (λ _, (ms, x))

def return {A : Type u} (x : A) : act A := just_send_messages [] x
end act

/-- Indicates that an agent is polling -/
inductive polls_on_socket {A : Type u} (s : socket) : act A → Prop
| mk : ∀ ports sockets bound cont, 0 < bound → s ∈ sockets
  → polls_on_socket (act.poll ports sockets bound cont)

instance polls_decidable {A : Type} (s : socket) : decidable_pred (@polls_on_socket A s)
:= begin
intros x, induction x,
apply (if H : 0 < bound ∧ s ∈ sockets then _ else _),
{ apply decidable.is_true, induction H with H1 H2,
  constructor; assumption },
{ apply decidable.is_false, intros contra, cases contra,
  apply H, split; assumption }
end

-- An agent is defined as a type for the internal state, an process that produces
-- the state, and a looping process that will execute when the process is complete.
--
-- Semantically, think of the behavior as `next >>= forever loop` where
-- `forever loop = loop >=> forever loop`.
structure agent : Type 1 :=
  (state_type : Type)
  (loop : state_type → act state_type)

inductive dlabel {A : Type u} : act A → Type u
| poll : ∀ (ports : list port) (sockets : list socket) (bound : time) cont
    (r : poll_result ports sockets bound),
    dlabel (act.poll ports sockets bound cont)

namespace dlabel
def cont_result {A : Type u} : ∀ {next : act A} (la : dlabel next),
   list (socket × message_t) × A
| (act.poll ports sockets bound cont) (dlabel.poll ._ ._ ._ ._ r) := cont r

def messages {A : Type u} {next : act A} (la : dlabel next) : list (socket × message_t)
  := la.cont_result.fst

lemma invert {A : Type u}
  {ports sockets bound cont} (l : @dlabel A (act.poll ports sockets bound cont))
  : ∃ r : poll_result ports sockets bound,
    l = dlabel.poll ports sockets bound cont r
:= begin
cases l, constructor, reflexivity
end
end dlabel

end network


/-
  Specifications file for bigint_spec.cairo

  Do not modify the constant definitions, structure definitions, or automatic specifications.
  Do not change the name or arguments of the user specifications and soundness theorems.

  You may freely move the definitions around in the file.
  You may add definitions and theorems wherever you wish in this file.
-/
import starkware.cairo.lean.semantics.soundness.prelude
import starkware.cairo.common.cairo_secp.constants_spec

open starkware.cairo.common.cairo_secp.constants

namespace starkware.cairo.common.cairo_secp.bigint

variables {F : Type} [field F] [decidable_eq F] [prelude_hyps F]

-- End of automatically generated prelude.

-- Main scope definitions.

@[ext] structure BigInt3 (F : Type) :=
  ( d0 : F ) ( d1 : F ) ( d2 : F )
attribute [derive decidable_eq] BigInt3
@[ext] structure π_BigInt3 (F : Type) :=
  ( σ_ptr : F ) ( d0 : F ) ( d1 : F ) ( d2 : F )
@[reducible] def φ_BigInt3.d0 := 0
@[reducible] def φ_BigInt3.d1 := 1
@[reducible] def φ_BigInt3.d2 := 2
@[reducible] def φ_BigInt3.SIZE := 3
@[reducible] def cast_BigInt3 (mem : F → F) (p : F) : BigInt3 F := {
  d0 := mem (p + φ_BigInt3.d0),
  d1 := mem (p + φ_BigInt3.d1),
  d2 := mem (p + φ_BigInt3.d2)
}
@[reducible] def cast_π_BigInt3 (mem : F → F) (p : F) : π_BigInt3 F := {
  σ_ptr := mem p,
  d0 := mem ((mem p) + φ_BigInt3.d0),
  d1 := mem ((mem p) + φ_BigInt3.d1),
  d2 := mem ((mem p) + φ_BigInt3.d2)
}
instance π_BigInt3_to_F : has_coe (π_BigInt3 F) F := ⟨λ s, s.σ_ptr⟩
@[ext] structure UnreducedBigInt5 (F : Type) :=
  ( d0 : F ) ( d1 : F ) ( d2 : F ) ( d3 : F ) ( d4 : F )
@[ext] structure π_UnreducedBigInt5 (F : Type) :=
  ( σ_ptr : F ) ( d0 : F ) ( d1 : F ) ( d2 : F ) ( d3 : F ) ( d4 : F )
@[reducible] def φ_UnreducedBigInt5.d0 := 0
@[reducible] def φ_UnreducedBigInt5.d1 := 1
@[reducible] def φ_UnreducedBigInt5.d2 := 2
@[reducible] def φ_UnreducedBigInt5.d3 := 3
@[reducible] def φ_UnreducedBigInt5.d4 := 4
@[reducible] def φ_UnreducedBigInt5.SIZE := 5
@[reducible] def cast_UnreducedBigInt5 (mem : F → F) (p : F) : UnreducedBigInt5 F := {
  d0 := mem (p + φ_UnreducedBigInt5.d0),
  d1 := mem (p + φ_UnreducedBigInt5.d1),
  d2 := mem (p + φ_UnreducedBigInt5.d2),
  d3 := mem (p + φ_UnreducedBigInt5.d3),
  d4 := mem (p + φ_UnreducedBigInt5.d4)
}
@[reducible] def cast_π_UnreducedBigInt5 (mem : F → F) (p : F) : π_UnreducedBigInt5 F := {
  σ_ptr := mem p,
  d0 := mem ((mem p) + φ_UnreducedBigInt5.d0),
  d1 := mem ((mem p) + φ_UnreducedBigInt5.d1),
  d2 := mem ((mem p) + φ_UnreducedBigInt5.d2),
  d3 := mem ((mem p) + φ_UnreducedBigInt5.d3),
  d4 := mem ((mem p) + φ_UnreducedBigInt5.d4)
}
instance π_UnreducedBigInt5_to_F : has_coe (π_UnreducedBigInt5 F) F := ⟨λ s, s.σ_ptr⟩
@[ext] structure UnreducedBigInt3 (F : Type) :=
  ( d0 : F ) ( d1 : F ) ( d2 : F )
@[ext] structure π_UnreducedBigInt3 (F : Type) :=
  ( σ_ptr : F ) ( d0 : F ) ( d1 : F ) ( d2 : F )
@[reducible] def φ_UnreducedBigInt3.d0 := 0
@[reducible] def φ_UnreducedBigInt3.d1 := 1
@[reducible] def φ_UnreducedBigInt3.d2 := 2
@[reducible] def φ_UnreducedBigInt3.SIZE := 3
@[reducible] def cast_UnreducedBigInt3 (mem : F → F) (p : F) : UnreducedBigInt3 F := {
  d0 := mem (p + φ_UnreducedBigInt3.d0),
  d1 := mem (p + φ_UnreducedBigInt3.d1),
  d2 := mem (p + φ_UnreducedBigInt3.d2)
}
@[reducible] def cast_π_UnreducedBigInt3 (mem : F → F) (p : F) : π_UnreducedBigInt3 F := {
  σ_ptr := mem p,
  d0 := mem ((mem p) + φ_UnreducedBigInt3.d0),
  d1 := mem ((mem p) + φ_UnreducedBigInt3.d1),
  d2 := mem ((mem p) + φ_UnreducedBigInt3.d2)
}
instance π_UnreducedBigInt3_to_F : has_coe (π_UnreducedBigInt3 F) F := ⟨λ s, s.σ_ptr⟩

-- End of main scope definitions.

namespace nondet_bigint3

@[reducible] def MAX_SUM := 3 * (BASE - 1)

end nondet_bigint3

namespace BigInt3

def add (x y : BigInt3 F) : BigInt3 F :=
{ d0 := x.d0 + y.d0, d1 := x.d1 + y.d1, d2 := x.d2 + y.d2 }

def sub (x y : BigInt3 F) : BigInt3 F :=
{ d0 := x.d0 - y.d0, d1 := x.d1 - y.d1, d2 := x.d2 - y.d2 }

end BigInt3

namespace UnreducedBigInt3

def add (x y : UnreducedBigInt3 F) : UnreducedBigInt3 F :=
{ d0 := x.d0 + y.d0, d1 := x.d1 + y.d1, d2 := x.d2 + y.d2 }

def sub (x y : UnreducedBigInt3 F) : UnreducedBigInt3 F :=
{ d0 := x.d0 - y.d0, d1 := x.d1 - y.d1, d2 := x.d2 - y.d2 }

end UnreducedBigInt3

@[ext]
structure bigint3 := (i0 i1 i2 : ℤ)

namespace bigint3

def val (x : bigint3) : int := x.i2 * ↑BASE^2 + x.i1 * ↑BASE + x.i0

def toBigInt3 (x : bigint3) : BigInt3 F := ⟨x.i0, x.i1, x.i2⟩

def toUnreducedBigInt3 (x : bigint3) : UnreducedBigInt3 F := ⟨x.i0, x.i1, x.i2⟩

def add (x y : bigint3) : bigint3 :=
{ i0 := x.i0 + y.i0, i1 := x.i1 + y.i1, i2 := x.i2 + y.i2 }

theorem toBigInt3_add (x y : bigint3) : ((x.add y).toBigInt3 : BigInt3 F) =
  BigInt3.add (x.toBigInt3) (y.toBigInt3) :=
by simp [BigInt3.add, toBigInt3, bigint3.add]

theorem toUnreducedBigInt3_add (x y : bigint3) :
    ((x.add y).toUnreducedBigInt3 : UnreducedBigInt3 F) =
  UnreducedBigInt3.add (x.toUnreducedBigInt3) (y.toUnreducedBigInt3) :=
by simp [UnreducedBigInt3.add, toUnreducedBigInt3, bigint3.add]

theorem add_val (x y : bigint3) : (x.add y).val = x.val + y.val :=
by { simp [val, add], ring }

def sub (x y : bigint3) : bigint3 :=
{ i0 := x.i0 - y.i0, i1 := x.i1 - y.i1, i2 := x.i2 - y.i2 }

theorem toBigInt3_sub (x y : bigint3) : ((x.sub y).toBigInt3 : BigInt3 F) =
  BigInt3.sub (x.toBigInt3) (y.toBigInt3) :=
by simp [BigInt3.sub, toBigInt3, bigint3.sub]

theorem toUnreducedBigInt3_sub (x y : bigint3) : ((x.sub y).toUnreducedBigInt3 : UnreducedBigInt3 F) =
  UnreducedBigInt3.sub (x.toUnreducedBigInt3) (y.toUnreducedBigInt3) :=
by simp [UnreducedBigInt3.sub, toUnreducedBigInt3, bigint3.sub]

theorem sub_val (x y : bigint3) : (x.sub y).val = x.val - y.val :=
by { simp [val, sub], ring }

def cmul (c : ℤ) (x : bigint3) : bigint3 :=
{ i0 := c * x.i0, i1 := c * x.i1, i2 := c * x.i2}

theorem cmul_val (c : ℤ) (x : bigint3) : (x.cmul c).val = c * x.val :=
by { simp [val, cmul], ring }

def mul (x y : bigint3) : bigint3 :=
{ i0 := x.i0 * y.i0 + (x.i1 * y.i2 + x.i2 * y.i1) * (4 * SECP_REM),
  i1 := x.i0 * y.i1 + x.i1 * y.i0 + (x.i2 * y.i2) * (4 * SECP_REM),
  i2 := x.i0 * y.i2 + x.i1 * y.i1 + x.i2 * y.i0 }

theorem mul_val (x y : bigint3) : (x.mul y).val ≡ x.val * y.val [ZMOD ↑SECP_PRIME] :=
begin
  have aux : (4 : ℤ) ∣ ↑BASE ^ 3,
  { dsimp only [BASE], simp_int_casts, norm_num1 },
  rw [int.modeq_iff_dvd],
  use [4 * (x.i1 * y.i2 + x.i2 * y.i1 + BASE * (x.i2 * y.i2))],
  rw SECP_PRIME_eq,
  simp only [val, mul],
  conv { to_rhs, rw [←mul_assoc, sub_mul, int.div_mul_cancel aux] },
  generalize : SECP_REM = S,
  generalize : BASE = B,
  ring
end

def sqr (x : bigint3) : bigint3 := x.mul x

theorem sqr_val (x : bigint3) : x.sqr.val ≡ x.val^2 [ZMOD ↑SECP_PRIME] :=
by { rw pow_two, exact mul_val x x }

def bounded (x : bigint3) (b : ℤ) := abs x.i0 ≤ b ∧ abs x.i1 ≤ b ∧ abs x.i2 ≤ b

theorem bounded_of_bounded_of_le {x : bigint3} {b₁ b₂ : ℤ} (bddx : x.bounded b₁) (hle : b₁ ≤ b₂) :
  x.bounded b₂ :=
⟨bddx.1.trans hle, bddx.2.1.trans hle, bddx.2.2.trans hle⟩

theorem bounded_add {x y : bigint3} {b₁ b₂ : int} (bddx : x.bounded b₁) (bddy : y.bounded b₂) :
  (x.add y).bounded (b₁ + b₂) :=
⟨(abs_add _ _).trans (add_le_add bddx.1 bddy.1),
  (abs_add _ _).trans (add_le_add bddx.2.1 bddy.2.1),
  (abs_add _ _).trans (add_le_add bddx.2.2 bddy.2.2)⟩

theorem bounded_sub {x y : bigint3} {b₁ b₂ : int} (bddx : x.bounded b₁) (bddy : y.bounded b₂) :
  (x.sub y).bounded (b₁ + b₂) :=
⟨(abs_sub _ _).trans (add_le_add bddx.1 bddy.1),
         (abs_sub _ _).trans (add_le_add bddx.2.1 bddy.2.1),
         (abs_sub _ _).trans (add_le_add bddx.2.2 bddy.2.2)⟩

theorem bounded_cmul {x : bigint3} {c b : int} (bddx : x.bounded b) :
  (x.cmul c).bounded (abs c * b) :=
begin
  simp [cmul, bigint3.bounded, abs_mul],
  exact ⟨mul_le_mul_of_nonneg_left bddx.1 (abs_nonneg _),
         mul_le_mul_of_nonneg_left bddx.2.1 (abs_nonneg _),
         mul_le_mul_of_nonneg_left bddx.2.2 (abs_nonneg _)⟩
end

theorem bounded_cmul' {x : bigint3} {c b : int} (h : 0 ≤ c) (bddx : x.bounded b) :
  (x.cmul c).bounded (c * b) :=
by { convert bounded_cmul bddx, rw abs_of_nonneg h }

theorem bounded_mul {x y : bigint3} {b : ℤ} (hx : x.bounded b) (hy : y.bounded b) :
  (x.mul y).bounded (b^2 * (8 * SECP_REM + 1)) :=
begin
  have bnonneg : 0 ≤ b := le_trans (abs_nonneg _) hx.1,
  have secp4nonneg : (0 : ℤ) ≤ 4 * ↑SECP_REM,
  { apply mul_nonneg, norm_num1, rw [SECP_REM], simp_int_casts, norm_num1 },
  have secp4ge1 : (1 : ℤ) ≤ 4 * ↑SECP_REM,
  { rw [SECP_REM], simp_int_casts, norm_num1 },
  simp only [bigint3.mul, bigint3.bounded],
  split,
  { transitivity b * b + (b * b + b * b) * (4 * ↑SECP_REM),
    { apply le_trans, apply abs_add,
      apply add_le_add, rw abs_mul,
      apply mul_le_mul hx.1 hy.1 (abs_nonneg _) bnonneg,
      rw [abs_mul, abs_of_nonneg secp4nonneg],
      apply mul_le_mul_of_nonneg_right _ secp4nonneg,
      apply le_trans, apply abs_add, rw [abs_mul, abs_mul],
      apply add_le_add, apply mul_le_mul hx.2.1 hy.2.2 (abs_nonneg _) bnonneg,
      apply mul_le_mul hx.2.2 hy.2.1 (abs_nonneg _) bnonneg },
    apply le_of_eq, ring },
  split,
  { transitivity b * b + b * (b * (4 * ↑SECP_REM)) + (b * b) * (4 * ↑SECP_REM),
    { apply le_trans, apply abs_add,
      apply add_le_add,
      apply le_trans, apply abs_add,
      rw [abs_mul, abs_mul], apply add_le_add,
      apply mul_le_mul hx.1 hy.2.1 (abs_nonneg _) bnonneg,
      apply mul_le_mul hx.2.1 _ (abs_nonneg _) bnonneg,
      rw [←mul_one(abs y.i0)],
      apply mul_le_mul hy.1 secp4ge1 zero_le_one bnonneg,
      rw [abs_mul, abs_mul, abs_of_nonneg secp4nonneg],
      apply mul_le_mul_of_nonneg_right _ secp4nonneg,
      apply mul_le_mul hx.2.2 hy.2.2 (abs_nonneg _) bnonneg,
    },
    apply le_of_eq, ring },
  transitivity (b * b + b * b + b * b),
  apply le_trans, apply abs_add, apply add_le_add,
  apply le_trans, apply abs_add, rw [abs_mul, abs_mul],
  apply add_le_add,
  apply mul_le_mul hx.1 hy.2.2 (abs_nonneg _) bnonneg,
  apply mul_le_mul hx.2.1 hy.2.1 (abs_nonneg _) bnonneg,
  rw abs_mul,
  apply mul_le_mul hx.2.2 hy.1 (abs_nonneg _) bnonneg,
  transitivity (b^2 * 3),
  apply le_of_eq, ring,
  apply mul_le_mul_of_nonneg_left _ (pow_two_nonneg b),
  rw [SECP_REM], simp_int_casts, norm_num1
end

theorem bounded_sqr {x : bigint3} {b : ℤ} (hx : x.bounded b) :
  (x.sqr).bounded (b^2 * (8 * SECP_REM + 1)) :=
bounded_mul hx hx

end bigint3

theorem bigint3_eqs {x : BigInt3 F} {i0 i1 i2 : ℤ} (h : x = (bigint3.mk i0 i1 i2).toBigInt3) :
  x.d0 = i0 ∧ x.d1 = i1 ∧ x.d2 = i2 :=
by { rwa BigInt3.ext_iff at h }

theorem unreduced_bigint3_eqs {x : UnreducedBigInt3 F} {i0 i1 i2 : ℤ} (h : x = (bigint3.mk i0 i1 i2).toUnreducedBigInt3) :
  x.d0 = i0 ∧ x.d1 = i1 ∧ x.d2 = i2 :=
by { rwa UnreducedBigInt3.ext_iff at h }

theorem cast_int_eq_of_bdd_3BASE {i j : int}
    (heq : (i : F) = (j : F))
    (ibdd : abs i ≤ 3 * BASE - 1)
    (jbdd : abs j ≤ 3 * BASE - 1) :
  i = j :=
begin
  apply PRIME.int_coe_inj heq,
  apply lt_of_le_of_lt,
  apply abs_sub,
  apply lt_of_le_of_lt,
  apply add_le_add jbdd ibdd,
  dsimp only [BASE, PRIME],
  simp_int_casts,
  norm_num
end

theorem toBigInt3_eq_toBigInt3_of_bounded_3BASE {a b : bigint3}
    (heq : (a.toBigInt3 : BigInt3 F) = b.toBigInt3)
    (abdd : a.bounded (3 * BASE - 1))
    (bbdd : b.bounded (3 * BASE - 1)) :
  a = b :=
begin
  simp [BigInt3.ext_iff, bigint3.toBigInt3] at heq,
  ext,
  { apply cast_int_eq_of_bdd_3BASE heq.1 abdd.1 bbdd.1 },
  { apply cast_int_eq_of_bdd_3BASE heq.2.1 abdd.2.1 bbdd.2.1 },
  { apply cast_int_eq_of_bdd_3BASE heq.2.2 abdd.2.2 bbdd.2.2 }
end

theorem toBigInt3_eq_zero_of_bounded_3BASE {a : bigint3}
    (heq : (a.toBigInt3 : BigInt3 F) = ⟨0, 0, 0⟩)
    (abdd : a.bounded (3 * BASE - 1)) :
  a = ⟨0, 0, 0⟩ :=
begin
  have : (a.toBigInt3 : BigInt3 F) = bigint3.toBigInt3 ⟨0, 0, 0⟩,
  { rw heq, simp [bigint3.toBigInt3] },
  apply toBigInt3_eq_toBigInt3_of_bounded_3BASE this abdd,
  simp [bigint3.bounded],
  norm_num
end

@[ext] structure bigint5 := (i0 i1 i2 i3 i4 : ℤ)

def bigint3.bigint5_mul (ix iy : bigint3) : bigint5 :=
{ i0 := ix.i0 * iy.i0,
  i1 := ix.i0 * iy.i1 + ix.i1 * iy.i0,
  i2 := ix.i0 * iy.i2 + ix.i1 * iy.i1 + ix.i2 * iy.i0,
  i3 := ix.i1 * iy.i2 + ix.i2 * iy.i1,
  i4 := ix.i2 * iy.i2 }

def BigInt3.UnreducedBigInt5_mul (x y : BigInt3 F) : UnreducedBigInt5 F :=
{ d0 := x.d0 * y.d0,
  d1 := x.d0 * y.d1 + x.d1 * y.d0,
  d2 := x.d0 * y.d2 + x.d1 * y.d1 + x.d2 * y.d0,
  d3 := x.d1 * y.d2 + x.d2 * y.d1,
  d4 := x.d2 * y.d2 }

def bigint5.toUnreducedBigInt5 (x : bigint5) : UnreducedBigInt5 F := ⟨x.i0, x.i1, x.i2, x.i3, x.i4⟩

theorem bigint3.bigint5_mul_toUnreducedBigInt5 (ix iy : bigint3) :
  ((ix.bigint5_mul iy).toUnreducedBigInt5 : UnreducedBigInt5 F) =
    (ix.toBigInt3).UnreducedBigInt5_mul (iy.toBigInt3) :=
by simp [bigint5.toUnreducedBigInt5, bigint3.toBigInt3, bigint3.bigint5_mul,
       BigInt3.UnreducedBigInt5_mul]

def bigint3.to_bigint5 (ix : bigint3) : bigint5 := ⟨ix.i0, ix.i1, ix.i2, 0, 0⟩

def BigInt3.toUnreducedBigInt5  {F : Type} [field F]
    (x : BigInt3 F) : UnreducedBigInt5 F := ⟨x.d0, x.d1, x.d2, 0, 0⟩

theorem bigint3.to_bigint5_to_Unreduced_BigInt5 (ix : bigint3) :
  (ix.to_bigint5.toUnreducedBigInt5 : UnreducedBigInt5 F) = ix.toBigInt3.toUnreducedBigInt5 :=
begin
  simp [bigint5.toUnreducedBigInt5, bigint3.to_bigint5, bigint3.toBigInt3,
    BigInt3.toUnreducedBigInt5]
end

namespace UnreducedBigInt5

def add (x y : UnreducedBigInt5 F) : UnreducedBigInt5 F :=
{ d0 := x.d0 + y.d0, d1 := x.d1 + y.d1, d2 := x.d2 + y.d2, d3 := x.d3 + y.d3, d4 := x.d4 + y.d4 }

def sub (x y : UnreducedBigInt5 F) : UnreducedBigInt5 F :=
{ d0 := x.d0 - y.d0, d1 := x.d1 - y.d1, d2 := x.d2 - y.d2, d3 := x.d3 - y.d3, d4 := x.d4 - y.d4 }

end UnreducedBigInt5

namespace bigint5

def val (x : bigint5) : int := x.i4 * ↑BASE^4 + x.i3 * ↑BASE^3 + x.i2 * ↑BASE^2 +
  x.i1 * ↑BASE + x.i0

def add (x y : bigint5) : bigint5 :=
{ i0 := x.i0 + y.i0, i1 := x.i1 + y.i1, i2 := x.i2 + y.i2, i3 := x.i3 + y.i3, i4 := x.i4 + y.i4 }

theorem toUnreducedBigInt5_add (x y : bigint5) :
    ((x.add y).toUnreducedBigInt5 : UnreducedBigInt5 F) =
  UnreducedBigInt5.add (x.toUnreducedBigInt5) (y.toUnreducedBigInt5) :=
by simp [UnreducedBigInt5.add, toUnreducedBigInt5, bigint5.add]

theorem add_val (x y : bigint5) : (x.add y).val = x.val + y.val :=
by { simp [val, add], ring }

def sub (x y : bigint5) : bigint5 :=
{ i0 := x.i0 - y.i0, i1 := x.i1 - y.i1, i2 := x.i2 - y.i2, i3 := x.i3 - y.i3, i4 := x.i4 - y.i4 }

theorem toUnreducedBigInt5_sub (x y : bigint5) :
    ((x.sub y).toUnreducedBigInt5 : UnreducedBigInt5 F) =
  UnreducedBigInt5.sub (x.toUnreducedBigInt5) (y.toUnreducedBigInt5) :=
by simp [UnreducedBigInt5.sub, toUnreducedBigInt5, bigint5.sub]

theorem sub_val (x y : bigint5) : (x.sub y).val = x.val - y.val :=
by { simp [val, sub], ring }

def cmul (c : ℤ) (x : bigint5) : bigint5 :=
{ i0 := c * x.i0, i1 := c * x.i1, i2 := c * x.i2, i3 := c * x.i3, i4 := c * x.i4 }

def bounded (x : bigint5) (b : ℤ) := abs x.i0 ≤ b ∧ abs x.i1 ≤ b ∧ abs x.i2 ≤ b ∧
  abs x.i3 ≤ b ∧ abs x.i4 ≤ b

theorem bounded_of_bounded_of_le {x : bigint5} {b₁ b₂ : ℤ} (bddx : x.bounded b₁) (hle : b₁ ≤ b₂) :
  x.bounded b₂ :=
⟨bddx.1.trans hle, bddx.2.1.trans hle, bddx.2.2.1.trans hle, bddx.2.2.2.1.trans hle,
  bddx.2.2.2.2.trans hle⟩

theorem bounded_add {x y : bigint5} {b₁ b₂ : int} (bddx : x.bounded b₁) (bddy : y.bounded b₂) :
  (x.add y).bounded (b₁ + b₂) :=
⟨(abs_add _ _).trans (add_le_add bddx.1 bddy.1),
  (abs_add _ _).trans (add_le_add bddx.2.1 bddy.2.1),
  (abs_add _ _).trans (add_le_add bddx.2.2.1 bddy.2.2.1),
  (abs_add _ _).trans (add_le_add bddx.2.2.2.1 bddy.2.2.2.1),
  (abs_add _ _).trans (add_le_add bddx.2.2.2.2 bddy.2.2.2.2)⟩

theorem bounded_sub {x y : bigint5} {b₁ b₂ : int} (bddx : x.bounded b₁) (bddy : y.bounded b₂) :
  (x.sub y).bounded (b₁ + b₂) :=
⟨(abs_sub _ _).trans (add_le_add bddx.1 bddy.1),
  (abs_sub _ _).trans (add_le_add bddx.2.1 bddy.2.1),
  (abs_sub _ _).trans (add_le_add bddx.2.2.1 bddy.2.2.1),
  (abs_sub _ _).trans (add_le_add bddx.2.2.2.1 bddy.2.2.2.1),
  (abs_sub _ _).trans (add_le_add bddx.2.2.2.2 bddy.2.2.2.2) ⟩

theorem bounded_cmul {x : bigint5} {c b : int} (bddx : x.bounded b) :
  (x.cmul c).bounded (abs c * b) :=
begin
  simp [cmul, bigint5.bounded, abs_mul],
  exact ⟨mul_le_mul_of_nonneg_left bddx.1 (abs_nonneg _),
         mul_le_mul_of_nonneg_left bddx.2.1 (abs_nonneg _),
         mul_le_mul_of_nonneg_left bddx.2.2.1 (abs_nonneg _),
         mul_le_mul_of_nonneg_left bddx.2.2.2.1 (abs_nonneg _),
         mul_le_mul_of_nonneg_left bddx.2.2.2.2 (abs_nonneg _)⟩
end

theorem bounded_cmul' {x : bigint5} {c b : int} (h : 0 ≤ c) (bddx : x.bounded b) :
  (x.cmul c).bounded (c * b) :=
by { convert bounded_cmul bddx, rw abs_of_nonneg h }

theorem toUnreducedBigInt5_eq_of_sub_bounded {a b : bigint5}
    (heq : (a.toUnreducedBigInt5 : UnreducedBigInt5 F) = b.toUnreducedBigInt5)
    (bdd : (b.sub a).bounded (PRIME - 1)) :
  a = b :=
begin
  simp [UnreducedBigInt5.ext_iff, bigint5.toUnreducedBigInt5] at heq,
  have h : (PRIME : ℤ) - 1 < PRIME, by norm_num,
  ext,
  exact PRIME.int_coe_inj heq.1 (lt_of_le_of_lt bdd.1 h),
  exact PRIME.int_coe_inj heq.2.1 (lt_of_le_of_lt bdd.2.1 h),
  exact PRIME.int_coe_inj heq.2.2.1 (lt_of_le_of_lt bdd.2.2.1 h),
  exact PRIME.int_coe_inj heq.2.2.2.1 (lt_of_le_of_lt bdd.2.2.2.1 h),
  exact PRIME.int_coe_inj heq.2.2.2.2 (lt_of_le_of_lt bdd.2.2.2.2 h),
end

end bigint5

theorem bigint3.bounded_bigint5_mul {x y : bigint3} {b : ℤ}
    (hx : x.bounded b) (hy : y.bounded b) :
  (x.bigint5_mul y).bounded (3 * b^2) :=
begin
  have bnn : 0 ≤ b := le_trans (abs_nonneg _) hx.1,
  have b2nn: 0 ≤ b^2 := sq_nonneg b,
  have b2le3b2   : b^2 ≤ 3 * b^2, by linarith,
  have b2b2le3b2 : b^2 + b^2 ≤ 3 * b^2, by linarith,
  have b23eq : 3 * b^2 = b^2 + b^2 + b^2, by linarith,
  simp [bigint3.bigint5_mul],
  split,
  { apply le_trans _ b2le3b2,
    rw [abs_mul, pow_two],
    exact mul_le_mul hx.1 hy.1 (abs_nonneg _) bnn },
  split,
  { apply le_trans _ b2b2le3b2,
    refine le_trans (abs_add _ _) _,
    simp_rw [abs_mul, pow_two],
    apply add_le_add,
    exact mul_le_mul hx.1 hy.2.1 (abs_nonneg _) bnn,
    exact mul_le_mul hx.2.1 hy.1 (abs_nonneg _) bnn },
  split,
  { rw [b23eq, pow_two],
    refine le_trans (abs_add _ _) _,
    apply add_le_add,
    refine le_trans (abs_add _ _) _,
    simp_rw abs_mul, apply add_le_add,
    exact mul_le_mul hx.1 hy.2.2 (abs_nonneg _) bnn,
    exact mul_le_mul hx.2.1 hy.2.1 (abs_nonneg _) bnn,
    rw abs_mul,
    exact mul_le_mul hx.2.2 hy.1 (abs_nonneg _) bnn },
  split,
  { apply le_trans _ b2b2le3b2,
    refine le_trans (abs_add _ _) _,
    simp_rw [abs_mul, pow_two],
    apply add_le_add,
    exact mul_le_mul hx.2.1 hy.2.2 (abs_nonneg _) bnn,
    exact mul_le_mul hx.2.2 hy.2.1 (abs_nonneg _) bnn },
  apply le_trans _ b2le3b2,
  rw [abs_mul, pow_two],
  exact mul_le_mul hx.2.2 hy.2.2 (abs_nonneg _) bnn
end

theorem bigint3.to_bigint5_bounded {x : bigint3} {b : ℤ} (hx : x.bounded b) :
  x.to_bigint5.bounded b :=
begin
  use [hx.1, hx.2.1, hx.2.2],
  simp [bigint3.to_bigint5],
  apply le_trans (abs_nonneg _ ) hx.1
end

/-
-- Function: bigint_mul
-/

/- bigint_mul autogenerated specification -/

-- Do not change this definition.
def auto_spec_bigint_mul (mem : F → F) (κ : ℕ) (x y : BigInt3 F) (ρ_res : UnreducedBigInt5 F) : Prop :=
  14 ≤ κ ∧
  ρ_res = {
    d0 := x.d0 * y.d0,
    d1 := x.d0 * y.d1 + x.d1 * y.d0,
    d2 := x.d0 * y.d2 + x.d1 * y.d1 + x.d2 * y.d0,
    d3 := x.d1 * y.d2 + x.d2 * y.d1,
    d4 := x.d2 * y.d2
  }

-- You may change anything in this definition except the name and arguments.
def spec_bigint_mul (mem : F → F) (κ : ℕ) (x y : BigInt3 F) (ρ_res : UnreducedBigInt5 F) : Prop :=
  ρ_res = x.UnreducedBigInt5_mul y

/- bigint_mul soundness theorem -/

-- Do not change the statement of this theorem. You may change the proof.
theorem sound_bigint_mul
    {mem : F → F}
    (κ : ℕ)
    (x y : BigInt3 F) (ρ_res : UnreducedBigInt5 F)
    (h_auto : auto_spec_bigint_mul mem κ x y ρ_res) :
  spec_bigint_mul mem κ x y ρ_res :=
begin
  exact h_auto.2
end

/-
-- Function: nondet_bigint3
-/

/- nondet_bigint3 autogenerated specification -/

-- Do not change this definition.
def auto_spec_nondet_bigint3 (mem : F → F) (κ : ℕ) (range_check_ptr ρ_range_check_ptr : F) (ρ_res : BigInt3 F) : Prop :=
  ∃ res : BigInt3 F,
  ∃ MAX_SUM : F, MAX_SUM = 232113757366008801543585789 ∧
  mem (range_check_ptr) = MAX_SUM - (res.d0 + res.d1 + res.d2) ∧
  is_range_checked (rc_bound F) (MAX_SUM - (res.d0 + res.d1 + res.d2)) ∧
  ∃ range_check_ptr₁ : F, range_check_ptr₁ = range_check_ptr + 4 ∧
  mem (range_check_ptr₁ - 3) = res.d0 ∧
  is_range_checked (rc_bound F) (res.d0) ∧
  mem (range_check_ptr₁ - 2) = res.d1 ∧
  is_range_checked (rc_bound F) (res.d1) ∧
  mem (range_check_ptr₁ - 1) = res.d2 ∧
  is_range_checked (rc_bound F) (res.d2) ∧
  10 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr₁ ∧
  ρ_res = res

-- You may change anything in this definition except the name and arguments.
def spec_nondet_bigint3 (mem : F → F) (κ : ℕ) (range_check_ptr ρ_range_check_ptr : F) (ρ_res : BigInt3 F) : Prop :=
  ∃ nd0 nd1 nd2 slack : ℕ,
    nd0 < rc_bound F ∧
    nd1 < rc_bound F ∧
    nd2 < rc_bound F ∧
    slack < rc_bound F ∧
    ρ_res = bigint3.toBigInt3 { i0 := nd0, i1 := nd1, i2 := nd2 } ∧
    nd0 + nd1 + nd2 + slack = 3 * (BASE - 1)

theorem nondet_bigint3_corr {mem : F → F} {k : ℕ} {range_check_ptr : F} {ret0 : F} {x : BigInt3 F}
    (h : spec_nondet_bigint3 mem k range_check_ptr ret0 x) :
  ∃ ix : bigint3, x = ix.toBigInt3 ∧ ix.bounded (3 * (BASE - 1)) :=
begin
  have BASEge1: 1 ≤ BASE, by { unfold BASE, norm_num1 },
  rcases h with ⟨nd0, nd1, nd2, _, _, _, _, _, xeq, sumeq⟩,
  refine ⟨_, xeq, _⟩,
  simp only [bigint3.bounded],
  have : (3 : ℤ) * (↑BASE - 1) = ↑(3 * (BASE - 1)),
  { rw [int.coe_nat_mul, int.coe_nat_sub BASEge1], simp },
  rw [this, ←sumeq], norm_cast, simp only [add_assoc],
  split, apply nat.le_add_right,
  split, apply le_trans (nat.le_add_right _ _) (nat.le_add_left _ _),
  apply le_trans _ (nat.le_add_left _ _),
  apply le_trans (nat.le_add_right _ _) (nat.le_add_left _ _),
end

/- nondet_bigint3 soundness theorem -/

-- Do not change the statement of this theorem. You may change the proof.
theorem sound_nondet_bigint3
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr ρ_range_check_ptr : F) (ρ_res : BigInt3 F)
    (h_auto : auto_spec_nondet_bigint3 mem κ range_check_ptr ρ_range_check_ptr ρ_res) :
  spec_nondet_bigint3 mem κ range_check_ptr ρ_range_check_ptr ρ_res :=
begin
  rcases h_auto with ⟨res, MAX_SUM, MAX_SUM_eq,
    _, ⟨slack, slack_lt, slack_eq⟩,
    rp1, rp1eq,
    resd0eq,
    ⟨nd0, nd0_lt, nd0_eq⟩,
    resd1eq,
    ⟨nd1, nd1_lt, nd1_eq⟩,
    resd2eq,
    ⟨nd2, nd2_lt, nd2_eq⟩,
    _,
    rp1eq',
    reseq⟩,
  use [nd0, nd1, nd2, slack, nd0_lt, nd1_lt, nd2_lt, slack_lt],
  split, { rw reseq, ext; simp [bigint3.toBigInt3]; assumption },
  rw BASE, norm_num1,
  apply @PRIME.nat_coe_field_inj F,
  transitivity 4 * rc_bound F, linarith,
  apply lt_of_le_of_lt (mul_le_mul_left' (rc_bound_hyp F) 4),
  rw PRIME, norm_num1,
  rw PRIME, norm_num1,
  simp only [nat.cast_add, ←slack_eq, ←nd0_eq, ←nd1_eq, ←nd2_eq, add_sub_cancel'_right, nat.cast_bit0, nat.cast_bit1, nat.cast_one],
  rw MAX_SUM_eq
end

end starkware.cairo.common.cairo_secp.bigint


import Lean
import Duper.RuleM

/- This code is copied from Lean's Discrimination Trees, but the support for
definitional equality has been removed. -/

namespace Duper

open Lean
open RuleM

initialize Lean.registerTraceClass `DiscrTree.debug

inductive Key where
  | const : Name → Nat → Key
  | fvar  : FVarId → Nat → Key
  | lit   : Literal → Key
  | star  : Key
  | other : Key
  | arrow : Key
  | proj  : Name → Nat → Key
  deriving Inhabited, BEq, Repr

protected def Key.hash : Key → UInt64
  | Key.const n a => mixHash 5237 $ mixHash (hash n) (hash a)
  | Key.fvar n a  => mixHash 3541 (hash a) --$ mixHash (hash n) (hash a)
  | Key.lit v     => mixHash 1879 $ hash v
  | Key.star      => 7883
  | Key.other     => 2411
  | Key.arrow     => 17
  | Key.proj s i  => mixHash 11 $ mixHash (hash s) (hash i)

instance : Hashable Key := ⟨Key.hash⟩

inductive Trie (α : Type) where
  | node (vs : Array α) (children : Array (Key × Trie α)) : Trie α

/- The filterSet argument is a temporary hack to simulate deletions from the discrimination tree. If that turns
   out to be too slow though, I'll have to remove it and rewrite delete to actually remove elements from the tree -/
structure DiscrTree (α : Type) where
  root : PersistentHashMap Key (Trie α) := {}
  filterSet : HashSet Clause := {} -- Keeps track of the set of clauses that should be filtered out (i.e. "removed" clauses)

def Key.ctorIdx : Key → Nat
  | Key.star     => 0
  | Key.other    => 1
  | Key.lit ..   => 2
  | Key.fvar ..  => 3
  | Key.const .. => 4
  | Key.arrow    => 5
  | Key.proj ..  => 6

def Key.lt : Key → Key → Bool
  | Key.lit v₁,      Key.lit v₂      => v₁ < v₂
  | Key.fvar n₁ a₁,  Key.fvar n₂ a₂  => a₁ < a₂ -- Name.quickLt n₁.name n₂.name || (n₁ == n₂ && a₁ < a₂)
  | Key.const n₁ a₁, Key.const n₂ a₂ => Name.quickLt n₁ n₂ || (n₁ == n₂ && a₁ < a₂)
  | Key.proj s₁ i₁,  Key.proj s₂ i₂  => Name.quickLt s₁ s₂ || (s₁ == s₂ && i₁ < i₂)
  | k₁,              k₂              => k₁.ctorIdx < k₂.ctorIdx

instance : LT Key := ⟨fun a b => Key.lt a b⟩
instance (a b : Key) : Decidable (a < b) := inferInstanceAs (Decidable (Key.lt a b))

def Key.format : Key → Format
  | Key.star                   => "*"
  | Key.other                  => "◾"
  | Key.lit (Literal.natVal v) => Std.format v
  | Key.lit (Literal.strVal v) => repr v
  | Key.const k _              => Std.format k
  | Key.proj s i               => Std.format s ++ "." ++ Std.format i
  | Key.fvar k _               => Std.format k.name
  | Key.arrow                  => "→"

instance : ToFormat Key := ⟨Key.format⟩

def Key.arity : Key → Nat
  | Key.const _ a => a
  | Key.fvar _ a  => a
  | Key.arrow     => 2
  | Key.proj ..   => 1
  | _             => 0

instance : Inhabited (Trie α) := ⟨Trie.node #[] #[]⟩

namespace DiscrTree

def empty : DiscrTree α := { root := {} }

partial def Trie.format [ToMessageData α] : Trie α → MessageData
  | Trie.node vs cs => MessageData.group $ MessageData.paren $
    "node" ++ (if vs.isEmpty then MessageData.nil else " " ++ toMessageData vs)
    ++ MessageData.joinSep (cs.toList.map $ fun ⟨k, c⟩ => MessageData.paren (toMessageData k ++ " => " ++ format c)) ","

partial def Trie.formatClause : Trie (Clause × α) → MessageData
  | Trie.node vs cs => MessageData.group $ MessageData.paren $
    "node" ++ (if vs.isEmpty then MessageData.nil else " " ++ toMessageData (Array.map (fun x => x.1) vs))
    ++ MessageData.joinSep (cs.toList.map $ fun ⟨k, c⟩ => MessageData.paren (toMessageData k ++ " => " ++ formatClause c)) ","

instance [ToMessageData α] : ToMessageData (Trie α) := ⟨Trie.format⟩
instance : ToMessageData (Trie (Clause × α)) := ⟨Trie.formatClause⟩

partial def format [ToMessageData α] (d : DiscrTree α) : MessageData :=
  let (_, r) := d.root.foldl
    (fun (p : Bool × MessageData) k c =>
      (false, p.2 ++ MessageData.paren (toMessageData k ++ " => " ++ toMessageData c)))
    (true, Format.nil)
  MessageData.group r

partial def formatClauses (d : DiscrTree (Clause × α)) : MessageData :=
  let (_, r) := d.root.foldl
    (fun (p : Bool × MessageData) k c =>
      (false, p.2 ++ MessageData.paren (toMessageData k ++ " => " ++ toMessageData c)))
    (true, Format.nil)
  MessageData.group r

instance [ToMessageData α] : ToMessageData (DiscrTree α) := ⟨fun dt => format dt⟩

/- The discrimination tree ignores some implicit arguments and proofs.
   We use the following auxiliary id as a "mark". -/
private def tmpMVarId : MVarId := { name := `_discr_tree_tmp }
private def tmpStar := mkMVar tmpMVarId

instance : Inhabited (DiscrTree α) where
  default := {}

/--
  Return true iff the argument should be treated as a "wildcard" by the discrimination tree.

  - We ignore proofs because of proof irrelevance. It doesn't make sense to try to
    index their structure.

  - We ignore instance implicit arguments (e.g., `[Add α]`) because they are "morally" canonical.
    Moreover, we may have many definitionally equal terms floating around.
    Example: `Ring.hasAdd Int Int.isRing` and `Int.hasAdd`.

  - We considered ignoring implicit arguments (e.g., `{α : Type}`) since users don't "see" them,
    and may not even understand why some simplification rule is not firing.
    However, in type class resolution, we have instance such as `Decidable (@Eq Nat x y)`,
    where `Nat` is an implicit argument. Thus, we would add the path
    ```
    Decidable -> Eq -> * -> * -> * -> [Nat.decEq]
    ```
    to the discrimination tree IF we ignored the implict `Nat` argument.
    This would be BAD since **ALL** decidable equality instances would be in the same path.
    So, we index implicit arguments if they are types.
    This setting seems sensible for simplification lemmas such as:
    ```
    forall (x y : Unit), (@Eq Unit x y) = true
    ```
    If we ignore the implicit argument `Unit`, the `DiscrTree` will say it is a candidate
    simplification lemma for any equality in our goal.

  Remark: if users have problems with the solution above, we may provide a `noIndexing` annotation,
  and `ignoreArg` would return true for any term of the form `noIndexing t`.

  Duper modification remark: The check of isProof has been removed and replaced with return false under the
  assumption that proofs won't be collected by the `collectAssumptions` function in Tactic.lean to begin with
  (additionally, attempting to actually call isProof is problematic because duper can attempt to index
  expressions that have escaped bound variables, which will cause isProof to panic)
-/
private def ignoreArg (a : Expr) (i : Nat) (infos : Array Meta.ParamInfo) : RuleM Bool := do
  if h : i < infos.size then
    let info := infos.get ⟨i, h⟩
    if info.isInstImplicit then
      return true
    else if info.isImplicit || info.isStrictImplicit then
      return not (← Meta.isType a)
    else
      return false -- Previously: isProof a
  else
    return false -- Previously: isProof a

private partial def pushArgsAux (infos : Array Meta.ParamInfo) : Nat → Expr → Array Expr → RuleM (Array Expr)
  | i, Expr.app f a, todo => do
    if (← ignoreArg a i infos) then
      pushArgsAux infos (i-1) f (todo.push tmpStar)
    else
      pushArgsAux infos (i-1) f (todo.push a)
  | _, _, todo => return todo

def mkNoindexAnnotation (e : Expr) : Expr :=
  mkAnnotation `noindex e

def hasNoindexAnnotation (e : Expr) : Bool :=
  annotation? `noindex e |>.isSome

private def pushArgs (root : Bool) (todo : Array Expr) (e : Expr) : RuleM (Key × Array Expr) := do
  if hasNoindexAnnotation e then
    return (Key.star, todo)
  else
    let fn := e.getAppFn
    let push (k : Key) (nargs : Nat) : RuleM (Key × Array Expr) := do
      let info ← Meta.getFunInfoNArgs fn nargs
      let todo ← pushArgsAux info.paramInfo (nargs-1) e todo
      return (k, todo)
    match fn with
    | Expr.lit v       => return (Key.lit v, todo)
    | Expr.const c _   =>
      let nargs := e.getAppNumArgs
      push (Key.const c nargs) nargs
    | Expr.proj s i a .. =>
      return (Key.proj s i, todo.push a)
    | Expr.fvar fvarId =>
      let nargs := e.getAppNumArgs
      push (Key.fvar fvarId nargs) nargs
    | Expr.mvar mvarId =>
      if mvarId == tmpMVarId then
        -- We use `tmp to mark some implicit arguments and proofs
        return (Key.star, todo)
      else
        return (Key.star, todo)
    | Expr.forallE _ d b _ =>
      if b.hasLooseBVars then
        return (Key.other, todo)
      else
        return (Key.arrow, todo.push d |>.push b)
    | _ =>
      return (Key.other, todo)

partial def mkPathAux (root : Bool) (todo : Array Expr) (keys : Array Key) : RuleM (Array Key) := do
  if todo.isEmpty then
    return keys
  else
    let e    := todo.back
    let todo := todo.pop
    let (k, todo) ← pushArgs root todo e
    mkPathAux false todo (keys.push k)

private def initCapacity := 8

def mkPath (e : Expr) : RuleM (Array Key) := do
  let todo : Array Expr := Array.mkEmpty initCapacity
  let keys : Array Key  := Array.mkEmpty initCapacity
  mkPathAux (root := true) (todo.push e) keys

private partial def createNodes (keys : Array Key) (v : α) (i : Nat) : Trie α :=
  if h : i < keys.size then
    let k := keys.get ⟨i, h⟩
    let c := createNodes keys v (i+1)
    Trie.node #[] #[(k, c)]
  else
    Trie.node #[v] #[]

private def insertVal [BEq α] (vs : Array α) (v : α) : Array α :=
  if vs.contains v then vs else vs.push v

private partial def insertAux [BEq α] (keys : Array Key) (v : α) : Nat → Trie α → Trie α
  | i, Trie.node vs cs =>
    if h : i < keys.size then
      let k := keys.get ⟨i, h⟩
      let c := Id.run $ cs.binInsertM
          (fun a b => a.1 < b.1)
          (fun ⟨_, s⟩ => let c := insertAux keys v (i+1) s; (k, c)) -- merge with existing
          (fun _ => let c := createNodes keys v (i+1); (k, c))
          (k, default)
      Trie.node vs c
    else
      Trie.node (insertVal vs v) cs

def insertCore [BEq α] (d : DiscrTree α) (keys : Array Key) (v : α) : DiscrTree α :=
  if keys.isEmpty then panic! "invalid key sequence"
  else
    let k := keys[0]!
    match d.root.find? k with
    | none =>
      let c := createNodes keys v 1
      { d with root := d.root.insert k c }
    | some c =>
      let c := insertAux keys v 1 c
      { d with root := d.root.insert k c }

/- Original, more general insert code for discrimination trees
def insert [BEq α] (d : DiscrTree α) (e : Expr) (v : α) : RuleM (DiscrTree α) := do
  let keys ← mkPath e
  return d.insertCore keys v
-/

def insert [BEq α] (d : DiscrTree (Clause × α)) (e : Expr) (v : (Clause × α)) : RuleM (DiscrTree (Clause × α)) := do
  let keys ← mkPath e
  let d := {d with filterSet := d.filterSet.erase v.1} -- In case if v.1 was previously removed, erase v.1 from d.filterSet
  return d.insertCore keys v

private def getKeyArgs (e : Expr) (isMatch root : Bool) : RuleM (Key × Array Expr) := do
  match e.getAppFn with
  | Expr.lit v       => return (Key.lit v, #[])
  | Expr.const c _   =>
    let nargs := e.getAppNumArgs
    return (Key.const c nargs, e.getAppRevArgs)
  | Expr.fvar fvarId =>
    let nargs := e.getAppNumArgs
    return (Key.fvar fvarId nargs, e.getAppRevArgs)
  | Expr.mvar _      =>
    if isMatch then
      return (Key.other, #[])
    else do
      return (Key.star, #[])
  | Expr.proj s i a .. =>
    return (Key.proj s i, #[a])
  | Expr.forallE _ d b _ =>
    if b.hasLooseBVars then
      return (Key.other, #[])
    else
      return (Key.arrow, #[d, b])
  | _ =>
    return (Key.other, #[])

private abbrev getMatchKeyArgs (e : Expr) (root : Bool) : RuleM (Key × Array Expr) :=
  getKeyArgs e (isMatch := true) (root := root)

private abbrev getUnifyKeyArgs (e : Expr) (root : Bool) : RuleM (Key × Array Expr) :=
  getKeyArgs e (isMatch := false) (root := root)

private def getStarResult (d : DiscrTree α) : Array α :=
  let result : Array α := Array.mkEmpty initCapacity
  match d.root.find? Key.star with
  | none                  => result
  | some (Trie.node vs _) => result ++ vs

private abbrev findKey (cs : Array (Key × Trie α)) (k : Key) : Option (Key × Trie α) :=
  cs.binSearch (k, default) (fun a b => a.1 < b.1)

private partial def getMatchLoop (todo : Array Expr) (c : Trie α) (result : Array α) : RuleM (Array α) := do
  match c with
  | Trie.node vs cs =>
    if todo.isEmpty then
      return result ++ vs
    else if cs.isEmpty then
      return result
    else
      let e     := todo.back
      let todo  := todo.pop
      let first := cs[0]! /- Recall that `Key.star` is the minimal key -/
      let (k, args) ← getMatchKeyArgs e (root := false)
      /- We must always visit `Key.star` edges since they are wildcards.
         Thus, `todo` is not used linearly when there is `Key.star` edge
         and there is an edge for `k` and `k != Key.star`. -/
      let visitStar (result : Array α) : RuleM (Array α) :=
        if first.1 == Key.star then
          getMatchLoop todo first.2 result
        else
          return result
      let visitNonStar (k : Key) (args : Array Expr) (result : Array α) : RuleM (Array α) :=
        match findKey cs k with
        | none   => return result
        | some c => getMatchLoop (todo ++ args) c.2 result
      let result ← visitStar result
      match k with
      | Key.star  => return result
      /-
        Recall that dependent arrows are `(Key.other, #[])`, and non-dependent arrows are `(Key.arrow, #[a, b])`.
        A non-dependent arrow may be an instance of a dependent arrow (stored at `DiscrTree`). Thus, we also visit the `Key.other` child.
      -/
      | Key.arrow => visitNonStar Key.other #[] (← visitNonStar k args result)
      | _         => visitNonStar k args result

private def getMatchRoot (d : DiscrTree α) (k : Key) (args : Array Expr) (result : Array α) : RuleM (Array α) :=
  match d.root.find? k with
  | none   => return result
  | some c => getMatchLoop args c result

private partial def getMatch' (d : DiscrTree α) (e : Expr) : RuleM (Array α) := do
  Core.checkMaxHeartbeats "getMatch"
  let result := getStarResult d
  let (k, args) ← getMatchKeyArgs e (root := true)
  match k with
  | Key.star => return result
  | _        => getMatchRoot d k args result

/-- Find values that match `e` in `d`. -/
partial def getMatch (d : DiscrTree (Clause × α)) (e : Expr) : RuleM (Array (Clause × α)) := do
  let unfiltered_result ← getMatch' d e
  let filterSet := d.filterSet
  return Array.filter (fun c => not (filterSet.contains c.1)) unfiltered_result

private partial def getUnify' (d : DiscrTree α) (e : Expr) : RuleM (Array α) := do
  Core.checkMaxHeartbeats "getUnify"
  let (k, args) ← getUnifyKeyArgs e (root := true)
  match k with
  | Key.star => d.root.foldlM (init := #[]) fun result k c => process k.arity #[] c result
  | _ =>
    let result := getStarResult d
    match d.root.find? k with
    | none   => return result
    | some c => process 0 args c result
where
  process (skip : Nat) (todo : Array Expr) (c : Trie α) (result : Array α) : RuleM (Array α) := do
    match skip, c with
    | skip+1, Trie.node vs cs =>
      if cs.isEmpty then
        return result
      else
        cs.foldlM (init := result) fun result ⟨k, c⟩ => process (skip + k.arity) todo c result
    | 0, Trie.node vs cs => do
      if todo.isEmpty then
        return result ++ vs
      else if cs.isEmpty then
        return result
      else
        let e     := todo.back
        let todo  := todo.pop
        let (k, args) ← getUnifyKeyArgs e (root := false)
        let visitStar (result : Array α) : RuleM (Array α) :=
          let first := cs[0]!
          if first.1 == Key.star then
            process 0 todo first.2 result
          else
            return result
        let visitNonStar (k : Key) (args : Array Expr) (result : Array α) : RuleM (Array α) :=
          match findKey cs k with
          | none   => return result
          | some c => process 0 (todo ++ args) c.2 result
        match k with
        | Key.star  => cs.foldlM (init := result) fun result ⟨k, c⟩ => process k.arity todo c result
        -- See comment a `getMatch` regarding non-dependent arrows vs dependent arrows
        | Key.arrow => visitNonStar Key.other #[] (← visitNonStar k args (← visitStar result))
        | _         => visitNonStar k args (← visitStar result)

partial def getUnify (d : DiscrTree (Clause × α)) (e : Expr) : RuleM (Array (Clause × α)) := do
  let unfiltered_result ← getUnify' d e
  let filterSet := d.filterSet
  return Array.filter (fun c => not (filterSet.contains c.1)) unfiltered_result

def delete (d : DiscrTree α) (c : Clause) : RuleM (DiscrTree α) := do
  let root := d.root
  let filterSet := d.filterSet.insert c
  return { root := root, filterSet := filterSet }

end DiscrTree
end Duper