ECC (generic modular exp actually)

ECC (generic modular exp actually)

--open import prelude renaming (Bool to 𝟚; true to 1₂; false to 0₂)
open import Relation.Binary.PropositionalEquality.NP
open import Data.Two.Base
open import Data.List
open import Function
open import Algebra.FunctionProperties.Eq
open Implicits
open import Algebra.Raw
open import Algebra.Field
open import Algebra.Monoid
open import Algebra.Monoid.Commutative
open import Algebra.Group

module ecc
  (ℙ : Set)
  (ℙ-monoid : Commutative-Monoid ℙ)
  (Number : Set)
  (+-comm-mon : Commutative-Monoid Number)
  (*-mon : Monoid Number)
  (open Additive-Commutative-Monoid +-comm-mon)
  (open Multiplicative-Monoid *-mon)
  (+-*-distr : ∀ {x y z} → (x + y) * z ≡ x * z + y * z)
  (*-+-distr : ∀ {x y z} → x * (y + z) ≡ x * y + x * z)
  (0*-zero : ∀ {x} → 0# * x ≡ 0#)
  (*0-zero : ∀ {x} → x * 0# ≡ 0#)
   --(modinv-*-distr : ∀ {x y} → modinv (x * y) ≡ modinv x * modinv y)
   --(modinv-modinv : ∀ {x} → modinv (modinv x) ≡ x)
   --(*-assoc : ∀ {x y z} → (x * y) * z ≡ x * (y * z))
   --(*-comm : ∀ {x y} → x * y ≡ y * x)
   --(modinv-cancel : ∀ {x y} → x * modinv x * y ≡ y)
   --(2*1ₙ : 2* 1# ≡ 2ₙ)
   --(2*-spec : ∀ {n} → 2* n ≡ 2ₙ * n)
  where

module ⊕ = Commutative-Monoid ℙ-monoid
open ⊕
  renaming
    ( _∙_ to _⊕_
    ; ∙= to ⊕=
    ; ε∙-identity to ε⊕-identity
    ; ∙ε-identity to ⊕ε-identity
    )

2·_ : ℙ → ℙ
2· P = P ⊕ P

2·-⊕-distr : ∀ {P Q} → 2· (P ⊕ Q) ≡ 2· P ⊕ 2· Q
2·-⊕-distr = ⊕.interchange

2·-⊕ : ∀ {P Q R} → 2· P ⊕ (Q ⊕ R) ≡ (P ⊕ Q) ⊕ (P ⊕ R)
2·-⊕ = ⊕.interchange

{-
ec-multiply-bin : List 𝟚 → ℙ → ℙ
ec-multiply-bin scalar P = go scalar
  where
    go : List 𝟚 → ℙ
    go []       = P
    go (b ∷ bs) = [0: x₀ 1: x₁ ] b
      where x₀ = 2· go bs
            x₁ = P ⊕ x₀

ec-multiply : Number → ℙ → ℙ
ec-multiply scalar P =
  -- if scalar == 0 or scalar >= N: raise Exception("Invalid Scalar/Private Key")
    ec-multiply-bin (bin scalar) P

_·_ = ec-multiply
infixr 8 _·_
-}

open From-Op₂.From-Assoc-Comm _+_ +-assoc +-comm
  renaming ( on-sides to +-on-sides)

infixl 6 1+_
infixl 7 2*_ 1+2*_
1+_ = λ x → 1# + x
2*_ = λ x → x + x
1+2*_ = λ x → 1+ 2* x

data Parity-View : Number → Set where
  zero⟨_⟩    : ∀ {n} → n ≡ 0# → Parity-View n
  even_by⟨_⟩ : ∀ {m n} → Parity-View m → n ≡ 2* m    → Parity-View n
  odd_by⟨_⟩  : ∀ {m n} → Parity-View m → n ≡ 1+ 2* m → Parity-View n

cast_by⟨_⟩ : ∀ {x y} → Parity-View x → y ≡ x → Parity-View y
cast zero⟨ xₑ ⟩       by⟨ yₑ ⟩ = zero⟨ yₑ ∙ xₑ ⟩
cast even xₚ by⟨ xₑ ⟩ by⟨ yₑ ⟩ = even xₚ by⟨ yₑ ∙ xₑ ⟩
cast odd  xₚ by⟨ xₑ ⟩ by⟨ yₑ ⟩ = odd  xₚ by⟨ yₑ ∙ xₑ ⟩

infixr 8 _·ₚ_
_·ₚ_ : ∀ {n} (p : Parity-View n) → ℙ → ℙ
zero⟨ e ⟩      ·ₚ P = ε
even p by⟨ e ⟩ ·ₚ P = 2· (p ·ₚ P)
odd  p by⟨ e ⟩ ·ₚ P = P ⊕ (2· (p ·ₚ P))

_+2*_ : 𝟚 → Number → Number
0₂ +2* m =   2* m
1₂ +2* m = 1+2* m

{-
postulate
    bin-2* : ∀ {n} → bin (2* n) ≡ 0₂ ∷ bin n
    bin-1+2* : ∀ {n} → bin (1+2* n) ≡ 1₂ ∷ bin n

bin-+2* : (b : 𝟚)(n : Number) → bin (b +2* n) ≡ b ∷ bin n
bin-+2* 1₂ n = bin-1+2*
bin-+2* 0₂ n = bin-2*
-}

-- (msb) most significant bit first
binₚ : ∀ {n} → Parity-View n → List 𝟚
binₚ zero⟨ e ⟩      = []
binₚ even p by⟨ e ⟩ = 0₂ ∷ binₚ p
binₚ odd  p by⟨ e ⟩ = 1₂ ∷ binₚ p

half : ∀ {n} → Parity-View n → Number
half zero⟨ _ ⟩            = 0#
half (even_by⟨_⟩ {m} _ _) = m
half (odd_by⟨_⟩  {m} _ _) = m

{-
bin-parity : ∀ {n} (p : ParityView n) → bin n ≡ parity p ∷ bin (half p)
bin-parity (even n) = bin-2*
bin-parity (odd n)  = bin-1+2*
-}

infixl 6 1+ₚ_ _+ₚ_
1+ₚ_ : ∀ {x} → Parity-View x → Parity-View (1+ x)
1+ₚ zero⟨ e ⟩      = odd zero⟨ refl ⟩ by⟨ ap 1+_ (e ∙ ! 0+-identity) ⟩
1+ₚ even p by⟨ e ⟩ = odd p      by⟨ ap 1+_ e ⟩
1+ₚ odd  p by⟨ e ⟩ = even 1+ₚ p by⟨ ap 1+_ e ∙ ! +-assoc ∙ +-interchange ⟩

_+ₚ_ : ∀ {x y} → Parity-View x → Parity-View y → Parity-View (x + y)
zero⟨ xₑ ⟩       +ₚ yₚ        = cast yₚ by⟨ ap (λ z → z + _) xₑ ∙ 0+-identity ⟩
xₚ              +ₚ zero⟨ yₑ ⟩ = cast xₚ by⟨ ap (_+_ _) yₑ ∙ +-comm ∙ 0+-identity ⟩
even xₚ by⟨ xₑ ⟩ +ₚ even yₚ by⟨ yₑ ⟩ = even     xₚ +ₚ yₚ by⟨ += xₑ yₑ ∙ +-interchange ⟩
even xₚ by⟨ xₑ ⟩ +ₚ odd  yₚ by⟨ yₑ ⟩ = odd      xₚ +ₚ yₚ by⟨ += xₑ yₑ ∙ +-comm ∙ +-assoc ∙ ap 1+_ (+-comm ∙ +-interchange) ⟩
odd  xₚ by⟨ xₑ ⟩ +ₚ even yₚ by⟨ yₑ ⟩ = odd      xₚ +ₚ yₚ by⟨ += xₑ yₑ ∙ +-assoc ∙ ap 1+_ +-interchange ⟩
odd  xₚ by⟨ xₑ ⟩ +ₚ odd  yₚ by⟨ yₑ ⟩ = even 1+ₚ (xₚ +ₚ yₚ) by⟨ += xₑ yₑ ∙ +-on-sides refl +-interchange ⟩

infixl 7 2*ₚ_
2*ₚ_ : ∀ {x} → Parity-View x → Parity-View (2* x)
2*ₚ xₚ = xₚ +ₚ xₚ

open ≡-Reasoning

module _ {P Q} where
    ·ₚ-⊕-distr : ∀ {x} (xₚ : Parity-View x) → xₚ ·ₚ (P ⊕ Q) ≡ xₚ ·ₚ P ⊕ xₚ ·ₚ Q
    ·ₚ-⊕-distr zero⟨ xₑ ⟩       = ! ε⊕-identity
    ·ₚ-⊕-distr even xₚ by⟨ xₑ ⟩ = ap 2·_ (·ₚ-⊕-distr xₚ) ∙ 2·-⊕-distr
    ·ₚ-⊕-distr odd  xₚ by⟨ xₑ ⟩ = ap (λ z → P ⊕ Q ⊕ 2· z) (·ₚ-⊕-distr xₚ)
                               ∙ ap (λ z → P ⊕ Q ⊕ z) (! 2·-⊕)
                               ∙ ⊕.interchange

module _ {P} where
    cast-·ₚ-distr : ∀ {x y} (xₚ : Parity-View x) (yₑ : y ≡ x) → cast xₚ by⟨ yₑ ⟩ ·ₚ P ≡ xₚ ·ₚ P
    cast-·ₚ-distr zero⟨ x₁ ⟩ yₑ = refl
    cast-·ₚ-distr even xₚ by⟨ x₁ ⟩ yₑ = refl
    cast-·ₚ-distr odd xₚ by⟨ x₁ ⟩ yₑ = refl

    1+ₚ-·ₚ-distr : ∀ {x} (xₚ : Parity-View x) → (1+ₚ xₚ) ·ₚ P ≡ P ⊕ xₚ ·ₚ P
    1+ₚ-·ₚ-distr zero⟨ xₑ ⟩       = ap (_⊕_ P) ε⊕-identity
    1+ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ = refl
    1+ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ = ap 2·_ (1+ₚ-·ₚ-distr xₚ) ∙ ⊕.interchange ∙ ⊕.assoc

    +ₚ-·ₚ-distr : ∀ {x y} (xₚ : Parity-View x) (yₚ : Parity-View y)
                 → (xₚ +ₚ yₚ) ·ₚ P ≡ xₚ ·ₚ P ⊕ yₚ ·ₚ P
    +ₚ-·ₚ-distr zero⟨ xₑ ⟩ yₚ = cast-·ₚ-distr yₚ _ ∙ ! ε⊕-identity

    +ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ zero⟨ yₑ ⟩ = ! ⊕ε-identity
    +ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ zero⟨ yₑ ⟩ = ! ⊕ε-identity

    +ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ even yₚ by⟨ yₑ ⟩ = ap 2·_ (+ₚ-·ₚ-distr xₚ yₚ) ∙ 2·-⊕-distr
    +ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ odd  yₚ by⟨ yₑ ⟩ = ap (_⊕_ P) (ap 2·_ (+ₚ-·ₚ-distr xₚ yₚ) ∙ 2·-⊕-distr) ∙ ⊕.assoc-comm
    +ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ even yₚ by⟨ yₑ ⟩ = ap (_⊕_ P) (ap 2·_ (+ₚ-·ₚ-distr xₚ yₚ) ∙ 2·-⊕-distr) ∙ ! ⊕.assoc
    +ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ odd  yₚ by⟨ yₑ ⟩
       = (odd xₚ by⟨ xₑ ⟩ +ₚ odd yₚ by⟨ yₑ ⟩) ·ₚ P
       ≡⟨by-definition⟩
         2·((1+ₚ (xₚ +ₚ yₚ)) ·ₚ P)
       ≡⟨ ap 2·_ helper ⟩
         2·(P ⊕ (xₚ ·ₚ P ⊕ yₚ ·ₚ P))
       ≡⟨ 2·-⊕-distr ⟩
         2· P ⊕ (2·(xₚ ·ₚ P ⊕ yₚ ·ₚ P))
       ≡⟨ ap (_⊕_ (2· P)) 2·-⊕-distr ⟩
         2· P ⊕ (2·(xₚ ·ₚ P) ⊕ 2·(yₚ ·ₚ P))
       ≡⟨ 2·-⊕ ⟩
         P ⊕ 2·(xₚ ·ₚ P) ⊕ (P ⊕ 2·(yₚ ·ₚ P))
       ≡⟨by-definition⟩
         odd xₚ by⟨ xₑ ⟩ ·ₚ P ⊕ odd yₚ by⟨ yₑ ⟩ ·ₚ P
       ∎
        where helper = (1+ₚ (xₚ +ₚ yₚ)) ·ₚ P
                     ≡⟨ 1+ₚ-·ₚ-distr (xₚ +ₚ yₚ) ⟩
                       P ⊕ ((xₚ +ₚ yₚ) ·ₚ P)
                     ≡⟨ ap (_⊕_ P) (+ₚ-·ₚ-distr xₚ yₚ) ⟩
                       P ⊕ (xₚ ·ₚ P ⊕ yₚ ·ₚ P)
                     ∎

*-1+-distr : ∀ {x y} → x * (1+ y) ≡ x + x * y
*-1+-distr = *-+-distr ∙ += *1-identity refl

1+-*-distr : ∀ {x y} → (1+ x) * y ≡ y + x * y
1+-*-distr = +-*-distr ∙ += 1*-identity refl

infixl 7 _*ₚ_
_*ₚ_ : ∀ {x y} → Parity-View x → Parity-View y → Parity-View (x * y)
zero⟨ xₑ ⟩       *ₚ yₚ              = zero⟨ *= xₑ refl ∙ 0*-zero ⟩
xₚ              *ₚ zero⟨ yₑ ⟩       = zero⟨ *= refl yₑ ∙ *0-zero ⟩
even xₚ by⟨ xₑ ⟩ *ₚ yₚ              = even (xₚ *ₚ yₚ) by⟨ *= xₑ refl ∙ +-*-distr ⟩
xₚ              *ₚ even yₚ by⟨ yₑ ⟩ = even (xₚ *ₚ yₚ) by⟨ *= refl yₑ ∙ *-+-distr ⟩
odd xₚ by⟨ xₑ ⟩  *ₚ odd yₚ by⟨ yₑ ⟩  = odd  (xₚ +ₚ yₚ +ₚ 2*ₚ (xₚ *ₚ yₚ)) by⟨ *= xₑ yₑ ∙ helper ⟩
   where
     x = _
     y = _
     helper = (1+2* x)*(1+2* y)
            ≡⟨ 1+-*-distr ⟩
              1+2* y + 2* x * 1+2* y
            ≡⟨ ap (λ z → 1+2* y + z)
                 (2* x * 1+2* y
                 ≡⟨ *-1+-distr ⟩
                 (2* x + 2* x * 2* y)
                 ≡⟨ += refl *-+-distr ∙ +-interchange ⟩
                 (2* (x + 2* x * y))
                 ∎) ⟩
              1+2* y + 2* (x + 2* x * y)
            ≡⟨ +-assoc ∙ ap 1+_ +-interchange ⟩
              1+2*(y + (x + 2* x * y))
            ≡⟨ ap 1+2*_ (! +-assoc ∙ += +-comm refl) ⟩
              1+2*(x + y + 2* x * y)
            ≡⟨ ap (λ z → 1+2*(x + y + z)) +-*-distr ⟩
              1+2*(x + y + 2* (x * y))
            ∎

module _ {P} where
    2·-·ₚ-distr : ∀ {x} (xₚ : Parity-View x) → 2·(xₚ ·ₚ P) ≡ xₚ ·ₚ 2· P
    2·-·ₚ-distr xₚ = ! ·ₚ-⊕-distr xₚ

    2*ₚ-·ₚ-distr : ∀ {x} (xₚ : Parity-View x) → (2*ₚ xₚ) ·ₚ P ≡ 2·(xₚ ·ₚ P)
    2*ₚ-·ₚ-distr xₚ = +ₚ-·ₚ-distr xₚ xₚ

·ₚ-ε : ∀ {x} (xₚ : Parity-View x) → xₚ ·ₚ ε ≡ ε
·ₚ-ε zero⟨ xₑ ⟩       = refl
·ₚ-ε even xₚ by⟨ xₑ ⟩ = ap 2·_ (·ₚ-ε xₚ) ∙ ε⊕-identity
·ₚ-ε odd xₚ by⟨ xₑ ⟩  = ε⊕-identity ∙ ap 2·_ (·ₚ-ε xₚ) ∙ ε⊕-identity

*ₚ-·ₚ-distr : ∀ {x y} (xₚ : Parity-View x) (yₚ : Parity-View y) {P} → (xₚ *ₚ yₚ) ·ₚ P ≡ xₚ ·ₚ yₚ ·ₚ P
*ₚ-·ₚ-distr zero⟨ xₑ ⟩ yₚ = refl
*ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ zero⟨ yₑ ⟩ = ! ·ₚ-ε even xₚ by⟨ xₑ ⟩
*ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ zero⟨ yₑ ⟩ = ! ·ₚ-ε odd  xₚ by⟨ xₑ ⟩

*ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ even yₚ by⟨ yₑ ⟩ = ap 2·_ (*ₚ-·ₚ-distr xₚ even yₚ by⟨ yₑ ⟩)
*ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ odd  yₚ by⟨ yₑ ⟩ = ap 2·_ (*ₚ-·ₚ-distr xₚ odd  yₚ by⟨ yₑ ⟩)

*ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ even yₚ by⟨ yₑ ⟩ {P} =
   ap 2·_ (*ₚ-·ₚ-distr odd xₚ by⟨ xₑ ⟩ yₚ) ∙ 2·-⊕-distr ∙ ap (λ z → 2· (yₚ ·ₚ P) ⊕ 2· z) (2·-·ₚ-distr xₚ)
*ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ odd  yₚ by⟨ yₑ ⟩ {P} =
   ap (_⊕_ P)
     (ap 2·_
        (+ₚ-·ₚ-distr (xₚ +ₚ yₚ) (2*ₚ (xₚ *ₚ yₚ))
        ∙ ⊕= (+ₚ-·ₚ-distr xₚ yₚ) (2*ₚ-·ₚ-distr (xₚ *ₚ yₚ))
        ∙ ⊕= ⊕.comm (ap 2·_ (*ₚ-·ₚ-distr xₚ yₚ) ∙ 2·-·ₚ-distr xₚ) ∙ ⊕.assoc
        ∙ ⊕= refl (! ·ₚ-⊕-distr xₚ) ) ∙ 2·-⊕-distr)
     ∙ ! ⊕.assoc
-- -}
-- -}
-- -}
-- -}

--open import prelude renaming (Bool to 𝟚; true to 1₂; false to 0₂)
open import Relation.Binary.PropositionalEquality.NP
open import Data.Two.Base
open import Data.List
open import Function
open import Algebra.FunctionProperties.Eq

module _ where

infixl 6 _+_ -- _-_
infixl 7 _*_ -- _%_
infixl 6 _+P_

postulate
  Number : Set
  _+_ _*_ : Number → Number → Number
 -- _-_ _/_ _%_ : Number → Number → Number
  -- Pcurve Acurve : Number
  0ₙ 1ₙ {-2ₙ 3ₙ-} : Number
  -- bin : Number → List 𝟚

  Point : Set
  _+P_ : Point → Point → Point
  +P-assoc : ∀ {P Q R} → (P +P Q) +P R ≡ P +P (Q +P R)
  +P-comm : ∀ {P Q} → P +P Q ≡ Q +P P

  0P : Point
  0P+-cancel : ∀ {x} → 0P +P x ≡ x

+0P-cancel : ∀ {x} → x +P 0P ≡ x
+0P-cancel = +P-comm ∙ 0P+-cancel

2·_ : Point → Point
2· P = P +P P

+P= : ∀ {x x' y y'} → x ≡ x' → y ≡ y' → x +P y ≡ x' +P y'
+P= {x} {y' = y'} p q = ap (_+P_ x) q ∙ ap (λ z → z +P y') p

+P-interchange : ∀ {x y z t} → (x +P y) +P (z +P t) ≡ (x +P z) +P (y +P t)
+P-interchange = InterchangeFromAssocComm.·-interchange _+P_ +P-assoc +P-comm

2·-+P-2· : ∀ {P Q} → 2· (P +P Q) ≡ 2· P +P 2· Q
2·-+P-2· = +P-interchange

+P-comm-2of3 : ∀ {P Q R} → P +P (Q +P R) ≡ Q +P (P +P R)
+P-comm-2of3 = ! +P-assoc ∙ +P= +P-comm refl ∙ +P-assoc

2·-+P : ∀ {P Q R} → 2· P +P (Q +P R) ≡ (P +P Q) +P (P +P R)
2·-+P = +P-interchange

{-
ec-multiply-bin : List 𝟚 → Point → Point
ec-multiply-bin scalar P = go scalar
  where
    go : List 𝟚 → Point
    go []       = P
    go (b ∷ bs) = [0: x₀ 1: x₁ ] b
      where x₀ = 2· go bs
            x₁ = P +P x₀

ec-multiply : Number → Point → Point
ec-multiply scalar P =
  -- if scalar == 0 or scalar >= N: raise Exception("Invalid Scalar/Private Key")
    ec-multiply-bin (bin scalar) P

_·_ = ec-multiply
infixr 8 _·_
-}

infixl 6 1+_
infixl 7 2*_ 1+2*_
1+_ = λ x → 1ₙ + x
2*_ = λ x → x + x
1+2*_ = λ x → 1+ 2* x

data Parity-View : Number → Set where
  zero⟨_⟩    : ∀ {n} → n ≡ 0ₙ → Parity-View n
  even_by⟨_⟩ : ∀ {m n} → Parity-View m → n ≡ 2* m    → Parity-View n
  odd_by⟨_⟩  : ∀ {m n} → Parity-View m → n ≡ 1+ 2* m → Parity-View n

cast_by⟨_⟩ : ∀ {x y} → Parity-View x → y ≡ x → Parity-View y
cast zero⟨ xₑ ⟩       by⟨ yₑ ⟩ = zero⟨ yₑ ∙ xₑ ⟩
cast even xₚ by⟨ xₑ ⟩ by⟨ yₑ ⟩ = even xₚ by⟨ yₑ ∙ xₑ ⟩
cast odd  xₚ by⟨ xₑ ⟩ by⟨ yₑ ⟩ = odd  xₚ by⟨ yₑ ∙ xₑ ⟩

infixr 8 _·ₚ_
_·ₚ_ : ∀ {n} (p : Parity-View n) → Point → Point
zero⟨ e ⟩      ·ₚ P = 0P
even p by⟨ e ⟩ ·ₚ P = 2· (p ·ₚ P)
odd  p by⟨ e ⟩ ·ₚ P = P +P (2· (p ·ₚ P))

+= : ∀ {x x' y y'} → x ≡ x' → y ≡ y' → x + y ≡ x' + y'
+= {x} {y' = y'} p q = ap (_+_ x) q ∙ ap (λ z → z + y') p

*= : ∀ {x x' y y'} → x ≡ x' → y ≡ y' → x * y ≡ x' * y'
*= {x} {y' = y'} p q = ap (_*_ x) q ∙ ap (λ z → z * y') p

module Addₚ
       (+-assoc : ∀ {x y z} → (x + y) + z ≡ x + (y + z))
       (+-comm : ∀ {x y} → x + y ≡ y + x)
       (0+-cancel : ∀ {x} → 0ₙ + x ≡ x)
       where

    +-interchange : ∀ {x y z t} → (x + y) + (z + t) ≡ (x + z) + (y + t)
    +-interchange = InterchangeFromAssocComm.·-interchange _+_ +-assoc +-comm

    +-on-sides : ∀ {x x' y y' z z' t t'}
                 → x + z ≡ x' + z'
                 → y + t ≡ y' + t'
                 → (x + y) + (z + t) ≡ (x' + y') + (z' + t')
    +-on-sides p q = +-interchange ∙ += p q ∙ +-interchange

    -- only needs interchange and comm
    {- UNUSED
    +-inner : ∀ {x y y' z z' t} → y + z ≡ z' + y' → (x + y) + (z + t) ≡ (x + y') + (z' + t)
    +-inner p = += +-comm refl ∙ +-on-sides (p ∙ +-comm) refl ∙ += +-comm refl
    -}

    _+2*_ : 𝟚 → Number → Number
    0₂ +2* m =   2* m
    1₂ +2* m = 1+2* m

    {-
    postulate
        bin-2* : ∀ {n} → bin (2* n) ≡ 0₂ ∷ bin n
        bin-1+2* : ∀ {n} → bin (1+2* n) ≡ 1₂ ∷ bin n

    bin-+2* : (b : 𝟚)(n : Number) → bin (b +2* n) ≡ b ∷ bin n
    bin-+2* 1₂ n = bin-1+2*
    bin-+2* 0₂ n = bin-2*
    -}

    -- (msb) most significant bit first
    binₚ : ∀ {n} → Parity-View n → List 𝟚
    binₚ zero⟨ e ⟩      = []
    binₚ even p by⟨ e ⟩ = 0₂ ∷ binₚ p
    binₚ odd  p by⟨ e ⟩ = 1₂ ∷ binₚ p

    half : ∀ {n} → Parity-View n → Number
    half zero⟨ _ ⟩            = 0ₙ
    half (even_by⟨_⟩ {m} _ _) = m
    half (odd_by⟨_⟩  {m} _ _) = m

    {-
    bin-parity : ∀ {n} (p : ParityView n) → bin n ≡ parity p ∷ bin (half p)
    bin-parity (even n) = bin-2*
    bin-parity (odd n)  = bin-1+2*
    -}

    infixl 6 1+ₚ_ _+ₚ_
    1+ₚ_ : ∀ {x} → Parity-View x → Parity-View (1+ x)
    1+ₚ zero⟨ e ⟩      = odd zero⟨ refl ⟩ by⟨ ap 1+_ (e ∙ ! 0+-cancel) ⟩
    1+ₚ even p by⟨ e ⟩ = odd p      by⟨ ap 1+_ e ⟩
    1+ₚ odd  p by⟨ e ⟩ = even 1+ₚ p by⟨ ap 1+_ e ∙ ! +-assoc ∙ +-interchange ⟩

    _+ₚ_ : ∀ {x y} → Parity-View x → Parity-View y → Parity-View (x + y)
    zero⟨ xₑ ⟩       +ₚ yₚ        = cast yₚ by⟨ ap (λ z → z + _) xₑ ∙ 0+-cancel ⟩
    xₚ              +ₚ zero⟨ yₑ ⟩ = cast xₚ by⟨ ap (_+_ _) yₑ ∙ +-comm ∙ 0+-cancel ⟩
    even xₚ by⟨ xₑ ⟩ +ₚ even yₚ by⟨ yₑ ⟩ = even     xₚ +ₚ yₚ by⟨ += xₑ yₑ ∙ +-interchange ⟩
    even xₚ by⟨ xₑ ⟩ +ₚ odd  yₚ by⟨ yₑ ⟩ = odd      xₚ +ₚ yₚ by⟨ += xₑ yₑ ∙ +-comm ∙ +-assoc ∙ ap 1+_ (+-comm ∙ +-interchange) ⟩
    odd  xₚ by⟨ xₑ ⟩ +ₚ even yₚ by⟨ yₑ ⟩ = odd      xₚ +ₚ yₚ by⟨ += xₑ yₑ ∙ +-assoc ∙ ap 1+_ +-interchange ⟩
    odd  xₚ by⟨ xₑ ⟩ +ₚ odd  yₚ by⟨ yₑ ⟩ = even 1+ₚ (xₚ +ₚ yₚ) by⟨ += xₑ yₑ ∙ +-on-sides refl +-interchange ⟩

    infixl 7 2*ₚ_
    2*ₚ_ : ∀ {x} → Parity-View x → Parity-View (2* x)
    2*ₚ xₚ = xₚ +ₚ xₚ

    open ≡-Reasoning

    module _ {P Q} where
        ·ₚ-+P-distr : ∀ {x} (xₚ : Parity-View x) → xₚ ·ₚ (P +P Q) ≡ xₚ ·ₚ P +P xₚ ·ₚ Q
        ·ₚ-+P-distr zero⟨ xₑ ⟩       = ! 0P+-cancel
        ·ₚ-+P-distr even xₚ by⟨ xₑ ⟩ = ap 2·_ (·ₚ-+P-distr xₚ) ∙ 2·-+P-2·
        ·ₚ-+P-distr odd  xₚ by⟨ xₑ ⟩ = ap (λ z → P +P Q +P 2· z) (·ₚ-+P-distr xₚ)
                                   ∙ ap (λ z → P +P Q +P z) (! 2·-+P)
                                   ∙ +P-interchange

    module _ {P} where
        cast-·ₚ-distr : ∀ {x y} (xₚ : Parity-View x) (yₑ : y ≡ x) → cast xₚ by⟨ yₑ ⟩ ·ₚ P ≡ xₚ ·ₚ P
        cast-·ₚ-distr zero⟨ x₁ ⟩ yₑ = refl
        cast-·ₚ-distr even xₚ by⟨ x₁ ⟩ yₑ = refl
        cast-·ₚ-distr odd xₚ by⟨ x₁ ⟩ yₑ = refl

        1+ₚ-·ₚ-distr : ∀ {x} (xₚ : Parity-View x) → (1+ₚ xₚ) ·ₚ P ≡ P +P xₚ ·ₚ P
        1+ₚ-·ₚ-distr zero⟨ xₑ ⟩       = ap (_+P_ P) 0P+-cancel
        1+ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ = refl
        1+ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ = ap 2·_ (1+ₚ-·ₚ-distr xₚ) ∙ +P-interchange ∙ +P-assoc

        +ₚ-·ₚ-distr : ∀ {x y} (xₚ : Parity-View x) (yₚ : Parity-View y)
                     → (xₚ +ₚ yₚ) ·ₚ P ≡ xₚ ·ₚ P +P yₚ ·ₚ P
        +ₚ-·ₚ-distr zero⟨ xₑ ⟩ yₚ = cast-·ₚ-distr yₚ _ ∙ ! 0P+-cancel

        +ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ zero⟨ yₑ ⟩ = ! +0P-cancel
        +ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ zero⟨ yₑ ⟩ = ! +0P-cancel

        +ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ even yₚ by⟨ yₑ ⟩ = ap 2·_ (+ₚ-·ₚ-distr xₚ yₚ) ∙ 2·-+P-2·
        +ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ odd  yₚ by⟨ yₑ ⟩ = ap (_+P_ P) (ap 2·_ (+ₚ-·ₚ-distr xₚ yₚ) ∙ 2·-+P-2·) ∙ +P-comm-2of3
        +ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ even yₚ by⟨ yₑ ⟩ = ap (_+P_ P) (ap 2·_ (+ₚ-·ₚ-distr xₚ yₚ) ∙ 2·-+P-2·) ∙ ! +P-assoc
        +ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ odd  yₚ by⟨ yₑ ⟩
           = (odd xₚ by⟨ xₑ ⟩ +ₚ odd yₚ by⟨ yₑ ⟩) ·ₚ P
           ≡⟨by-definition⟩
             2·((1+ₚ (xₚ +ₚ yₚ)) ·ₚ P)
           ≡⟨ ap 2·_ helper ⟩
             2·(P +P (xₚ ·ₚ P +P yₚ ·ₚ P))
           ≡⟨ 2·-+P-2· ⟩
             2· P +P (2·(xₚ ·ₚ P +P yₚ ·ₚ P))
           ≡⟨ ap (_+P_ (2· P)) 2·-+P-2· ⟩
             2· P +P (2·(xₚ ·ₚ P) +P 2·(yₚ ·ₚ P))
           ≡⟨ 2·-+P ⟩
             P +P 2·(xₚ ·ₚ P) +P (P +P 2·(yₚ ·ₚ P))
           ≡⟨by-definition⟩
             odd xₚ by⟨ xₑ ⟩ ·ₚ P +P odd yₚ by⟨ yₑ ⟩ ·ₚ P
           ∎
            where helper = (1+ₚ (xₚ +ₚ yₚ)) ·ₚ P
                         ≡⟨ 1+ₚ-·ₚ-distr (xₚ +ₚ yₚ) ⟩
                           P +P ((xₚ +ₚ yₚ) ·ₚ P)
                         ≡⟨ ap (_+P_ P) (+ₚ-·ₚ-distr xₚ yₚ) ⟩
                           P +P (xₚ ·ₚ P +P yₚ ·ₚ P)
                         ∎

    module Multₚ
       (+-*-distr : ∀ {x y z} → (x + y) * z ≡ x * z + y * z)
       (*-+-distr : ∀ {x y z} → x * (y + z) ≡ x * y + x * z)
       (1*-cancel : ∀ {x} → 1ₙ * x ≡ x)
       (*1-cancel : ∀ {x} → x * 1ₙ ≡ x)
       (0*-cancel : ∀ {x} → 0ₙ * x ≡ 0ₙ)
       (*0-cancel : ∀ {x} → x * 0ₙ ≡ 0ₙ)
       --(modinv-*-distr : ∀ {x y} → modinv (x * y) ≡ modinv x * modinv y)
       --(modinv-modinv : ∀ {x} → modinv (modinv x) ≡ x)
       --(*-assoc : ∀ {x y z} → (x * y) * z ≡ x * (y * z))
       --(*-comm : ∀ {x y} → x * y ≡ y * x)
       --(modinv-cancel : ∀ {x y} → x * modinv x * y ≡ y)
       --(2*1ₙ : 2* 1ₙ ≡ 2ₙ)
       --(2*-spec : ∀ {n} → 2* n ≡ 2ₙ * n)
       where

        *-1+-distr : ∀ {x y} → x * (1+ y) ≡ x + x * y
        *-1+-distr = *-+-distr ∙ += *1-cancel refl

        1+-*-distr : ∀ {x y} → (1+ x) * y ≡ y + x * y
        1+-*-distr = +-*-distr ∙ += 1*-cancel refl

        infixl 7 _*ₚ_
        _*ₚ_ : ∀ {x y} → Parity-View x → Parity-View y → Parity-View (x * y)
        zero⟨ xₑ ⟩       *ₚ yₚ              = zero⟨ *= xₑ refl ∙ 0*-cancel ⟩
        xₚ              *ₚ zero⟨ yₑ ⟩       = zero⟨ *= refl yₑ ∙ *0-cancel ⟩
        even xₚ by⟨ xₑ ⟩ *ₚ yₚ              = even (xₚ *ₚ yₚ) by⟨ *= xₑ refl ∙ +-*-distr ⟩
        xₚ              *ₚ even yₚ by⟨ yₑ ⟩ = even (xₚ *ₚ yₚ) by⟨ *= refl yₑ ∙ *-+-distr ⟩
        odd xₚ by⟨ xₑ ⟩  *ₚ odd yₚ by⟨ yₑ ⟩  = odd  (xₚ +ₚ yₚ +ₚ 2*ₚ (xₚ *ₚ yₚ)) by⟨ *= xₑ yₑ ∙ helper ⟩
           where
             x = _
             y = _
             helper = (1+2* x)*(1+2* y)
                    ≡⟨ 1+-*-distr ⟩
                      1+2* y + 2* x * 1+2* y
                    ≡⟨ ap (λ z → 1+2* y + z)
                         (2* x * 1+2* y
                         ≡⟨ *-1+-distr ⟩
                         (2* x + 2* x * 2* y)
                         ≡⟨ += refl *-+-distr ∙ +-interchange ⟩
                         (2* (x + 2* x * y))
                         ∎) ⟩
                      1+2* y + 2* (x + 2* x * y)
                    ≡⟨ +-assoc ∙ ap 1+_ +-interchange ⟩
                      1+2*(y + (x + 2* x * y))
                    ≡⟨ ap 1+2*_ (! +-assoc ∙ += +-comm refl) ⟩
                      1+2*(x + y + 2* x * y)
                    ≡⟨ ap (λ z → 1+2*(x + y + z)) +-*-distr ⟩
                      1+2*(x + y + 2* (x * y))
                    ∎

        module _ {P} where
            2·-·ₚ-distr : ∀ {x} (xₚ : Parity-View x) → 2·(xₚ ·ₚ P) ≡ xₚ ·ₚ 2· P
            2·-·ₚ-distr xₚ = ! ·ₚ-+P-distr xₚ

            2*ₚ-·ₚ-distr : ∀ {x} (xₚ : Parity-View x) → (2*ₚ xₚ) ·ₚ P ≡ 2·(xₚ ·ₚ P)
            2*ₚ-·ₚ-distr xₚ = +ₚ-·ₚ-distr xₚ xₚ

        ·ₚ-0P : ∀ {x} (xₚ : Parity-View x) → xₚ ·ₚ 0P ≡ 0P
        ·ₚ-0P zero⟨ xₑ ⟩       = refl
        ·ₚ-0P even xₚ by⟨ xₑ ⟩ = ap 2·_ (·ₚ-0P xₚ) ∙ 0P+-cancel
        ·ₚ-0P odd xₚ by⟨ xₑ ⟩  = 0P+-cancel ∙ ap 2·_ (·ₚ-0P xₚ) ∙ 0P+-cancel

        *ₚ-·ₚ-distr : ∀ {x y} (xₚ : Parity-View x) (yₚ : Parity-View y) {P} → (xₚ *ₚ yₚ) ·ₚ P ≡ xₚ ·ₚ yₚ ·ₚ P
        *ₚ-·ₚ-distr zero⟨ xₑ ⟩ yₚ = refl
        *ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ zero⟨ yₑ ⟩ = ! ·ₚ-0P even xₚ by⟨ xₑ ⟩
        *ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ zero⟨ yₑ ⟩ = ! ·ₚ-0P odd  xₚ by⟨ xₑ ⟩

        *ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ even yₚ by⟨ yₑ ⟩ = ap 2·_ (*ₚ-·ₚ-distr xₚ even yₚ by⟨ yₑ ⟩)
        *ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ odd  yₚ by⟨ yₑ ⟩ = ap 2·_ (*ₚ-·ₚ-distr xₚ odd  yₚ by⟨ yₑ ⟩)

        *ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ even yₚ by⟨ yₑ ⟩ {P} = ap 2·_ (*ₚ-·ₚ-distr odd xₚ by⟨ xₑ ⟩ yₚ) ∙ 2·-+P-2· ∙ ap (λ z → 2· (yₚ ·ₚ P) +P 2· z) (2·-·ₚ-distr xₚ)
        *ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ odd  yₚ by⟨ yₑ ⟩ {P} =
           ap (_+P_ P)
             (ap 2·_
                (+ₚ-·ₚ-distr (xₚ +ₚ yₚ) (2*ₚ (xₚ *ₚ yₚ))
                ∙ +P= (+ₚ-·ₚ-distr xₚ yₚ) (2*ₚ-·ₚ-distr (xₚ *ₚ yₚ))
                ∙ +P= +P-comm (ap 2·_ (*ₚ-·ₚ-distr xₚ yₚ) ∙ 2·-·ₚ-distr xₚ) ∙ +P-assoc
                ∙ +P= refl (! ·ₚ-+P-distr xₚ) ) ∙ 2·-+P-2·)
             ∙ ! +P-assoc
-- -}
-- -}
-- -}
-- -}


Direct proof of well-founded induction.

Direct proof of well-founded induction.

Ignore-this: be4f83042601bf8c031fec62e2fb0878

darcs-hash:20100525021915-3bd4e-695229f36277d68ee396016369b2744726dd84c7.gz

------------------------------------------------------------------------------
-- Well-founded induction on N
------------------------------------------------------------------------------

module LTC.Data.N.Induction.WellFounded where

open import LTC.Minimal

open import LTC.Data.N
open import LTC.Relation.Inequalities
open import LTC.Relation.Inequalities.Properties

------------------------------------------------------------------------------
-- Well-founded induction on N
-- Adapted from http://code.haskell.org/~dolio/agda-share/induction/.

wfIndN-LT :
   (P : D → Set) →
   ({m : D} → N m → ({n : D} → N n → LT n m → P n ) → P m ) →
   {n : D} → N n → P n
wfIndN-LT P accH Nn = accH Nn (wfAux Nn)
  where
    wfAux : {m : D} → N m → {n : D} → N n → LT n m → P n
    wfAux zN      Nn      n<0   = ⊥-elim (¬x<0 Nn n<0)
    wfAux (sN Nm) zN      0<Sm  = accH zN (λ Nn' n'<0 → ⊥-elim (¬x<0 Nn' n'<0))
    wfAux (sN {m} Nm) (sN {n} Nn) Sn<Sm =
      accH (sN Nn) (λ Nn' n'<Sn →
        wfAux Nm Nn' (Sx≤y→x<y Nn' Nm
                            (≤-trans (sN Nn') (sN Nn) Nm
                                     (x<y→Sx≤y Nn' (sN Nn) n'<Sn)
                                     (Sx≤Sy→x≤y {succ n} {m}
                                                (x<y→Sx≤y (sN Nn)
                                                          (sN Nm)
                                                          Sn<Sm)))))

------------------------------------------------------------------------------
-- Well-founded induction on N
------------------------------------------------------------------------------

module LTC.Data.N.Induction.WellFounded where

open import LTC.Minimal

open import LTC.Data.N
open import LTC.Relation.Inequalities
open import LTC.Relation.Inequalities.Properties

------------------------------------------------------------------------------
-- General setting.
-- Adapted from http://www.iis.sinica.edu.tw/~scm/2008/well-founded-recursion-and-accessibility/.

data AccN (R : D → D → Set) : {x : D} → N x → Set where
  accN : {x : D} → (Nx : N x) → ({y : D} → (Ny : N y) → R y x → AccN R Ny) →
         AccN R Nx

WellFoundedN : (D → D → Set) → Set
WellFoundedN R = {x : D} → (Nx : N x) → AccN R Nx

accFoldN : (R : D → D → Set){P : D → Set} →
           ({x : D} → N x → ({y : D} → N y → R y x → P y) → P x) →
           {x : D} → (Nx : N x) → AccN R Nx → P x
accFoldN R f Nx (accN .Nx h) = f Nx (λ Ny y<x → accFoldN R f Ny (h Ny y<x))

wfIndN : {R : D → D → Set} {P : D → Set} →
         WellFoundedN R →
         ({x : D} → N x → ({y : D} → N y → R y x → P y) → P x) →
         {x : D} → N x → P x
wfIndN {R = R} wf f Nx = accFoldN R f Nx (wf Nx)

------------------------------------------------------------------------------
-- LT is well-founded

-- Adapted from http://www.iis.sinica.edu.tw/~scm/2008/well-founded-recursion-and-accessibility/ and http://code.haskell.org/~dolio/agda-share/induction/.

access : {m : D} → N m → {n : D} → (Nn : N n) → LT n m → AccN LT Nn
access zN      Nn      n<0   = ⊥-elim (¬x<0 Nn n<0)
access (sN Nm) zN      0<Sm  = accN zN (λ Nn' n'<0 → ⊥-elim (¬x<0 Nn' n'<0))
access (sN {m} Nm) (sN {n} Nn) Sn<Sm =
  accN (sN Nn) (λ Nn' n'<Sn →
    access Nm Nn' (Sx≤y→x<y Nn' Nm
                            (≤-trans (sN Nn') (sN Nn) Nm
                                     (x<y→Sx≤y Nn' (sN Nn) n'<Sn)
                                     (Sx≤Sy→x≤y {succ n} {m} (x<y→Sx≤y (sN Nn)
                                                                       (sN Nm)
                                                                       Sn<Sm)))))

wf-LT : WellFoundedN LT
wf-LT Nx = accN Nx (access Nx)

------------------------------------------------------------------------------
-- Well-founded induction on N

wfIndN-LT :
   (P : D → Set) →
   ({m : D} → N m → ({n : D} → N n → LT n m → P n ) → P m ) →
   {n : D} → N n → P n
wfIndN-LT P accH Nn = wfIndN {LT} {λ x → P x} wf-LT accH Nn


Added x<y→Sx-y≡0 (by Ana Bove).

Added x<y→Sx-y≡0 (by Ana Bove).

Ignore-this: 8b8b39c215a93e23780151e5e8ec1a90

darcs-hash:20110210164212-3bd4e-08c2d3698ac5138c67a02ecd3e408ea7122dc0b2.gz

------------------------------------------------------------------------------
-- Properties of the inequalities
------------------------------------------------------------------------------

module LTC.Data.Nat.Inequalities.PropertiesATP where

open import LTC.Base
open import LTC.Base.Properties using ( x≡y→Sx≡Sy )

open import Common.Function using ( _$_ )

open import LTC.Data.Nat
  using ( _+_ ; _∸_ ; ∸-SS
        ; N ; sN ; zN  -- The LTC natural numbers type
        )
open import LTC.Data.Nat.Inequalities
  using ( <-00 ; <-0S ; <-S0 ; <-SS
        ; GE ; GT ; LE ; LT ; NGT ; NLE ; NLT
        ; LT₂
        )
open import LTC.Data.Nat.PropertiesATP
  using ( +-N ; ∸-N
        ; +-comm
        ; +-rightIdentity
        ; ∸-0x
        )

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

0<0-elim : LT zero zero → ⊥
0<0-elim 0<0 = true≠false $ trans (sym 0<0) <-00

S<0-elim : {d : D} → LT (succ d) zero → ⊥
S<0-elim {d} Sd<0 = true≠false $ trans (sym Sd<0) (<-S0 d)

x≥0 : ∀ {n} → N n → GE n zero
x≥0 zN          = <-0S zero
x≥0 (sN {n} Nn) = <-0S $ succ n

0≤x : ∀ {n} → N n → LE zero n
0≤x Nn = x≥0 Nn

¬x<0 : ∀ {n} → N n → ¬ (LT n zero)
¬x<0 zN      0<0  = 0<0-elim 0<0
¬x<0 (sN Nn) Sn<0 = S<0-elim Sn<0

0≯x : ∀ {n} → N n → NGT zero n
0≯x zN          = <-00
0≯x (sN {n} Nn) = <-S0 n

postulate
  ¬0>x : ∀ {n} → N n → ¬ (GT zero n)
{-# ATP prove ¬0>x 0≯x #-}

x≰x : ∀ {n} → N n → NLT n n
x≰x zN          = <-00
x≰x (sN {n} Nn) = trans (<-SS n n) (x≰x Nn)

S≰0 : ∀ {n} → N n → NLE (succ n) zero
S≰0 zN          = x≰x (sN zN)
S≰0 (sN {n} Nn) = trans (<-SS (succ n) zero) (<-S0 n)

¬S≤0 : ∀ {n} → N n → ¬ (LE (succ n) zero)
¬S≤0 {d} Nn Sn≤0 = true≠false $ trans (sym Sn≤0) (S≰0 Nn)

¬0≥S : ∀ {n} → N n → ¬ (GE zero (succ n))
¬0≥S Nn 0≥Sn = ¬S≤0 Nn 0≥Sn

x<Sx : ∀ {n} → N n → LT n (succ n)
x<Sx zN          = <-0S zero
x<Sx (sN {n} Nn) = trans (<-SS n (succ n)) (x<Sx Nn)

postulate
  x<y→Sx<Sy : ∀ {m n} → LT m n → LT (succ m) (succ n)
{-# ATP prove x<y→Sx<Sy #-}

postulate
  Sx<Sy→x<y : ∀ {m n} → LT (succ m) (succ n) → LT m n
{-# ATP prove Sx<Sy→x<y #-}

¬x<x : ∀ {n} → N n → ¬ (LT n n)
¬x<x zN           0<0  = 0<0-elim 0<0
¬x<x (sN {n} Nn) Sn<Sn = ⊥-elim $ ¬x<x Nn (trans (sym $ <-SS n n) Sn<Sn)

¬x>x : ∀ {n} → N n → ¬ (GT n n)
¬x>x Nn = ¬x<x Nn

x≤x : ∀ {n} → N n → LE n n
x≤x zN          = <-0S zero
x≤x (sN {n} Nn) = trans (<-SS n (succ n)) (x≤x Nn)

x≤y→Sx≤Sy : ∀ {m n} → LE m n → LE (succ m) (succ n)
x≤y→Sx≤Sy {m} {n} m≤n = trans (<-SS m (succ n)) m≤n

postulate
  Sx≤Sy→x≤y : ∀ {m n} → LE (succ m) (succ n) → LE m n
{-# ATP prove Sx≤Sy→x≤y #-}

x≰y→Sx≰Sy : ∀ m n → NLE m n → NLE (succ m) (succ n)
x≰y→Sx≰Sy m n m≰n = trans (<-SS m (succ n)) m≰n

x>y→y<x : ∀ {m n} → N m → N n → GT m n → LT n m
x>y→y<x zN          Nn          0>n   = ⊥-elim $ ¬0>x Nn 0>n
x>y→y<x (sN {m} Nm) zN          _     = <-0S m
x>y→y<x (sN {m} Nm) (sN {n} Nn) Sm>Sn =
  trans (<-SS n m) (x>y→y<x Nm Nn (trans (sym $ <-SS n m) Sm>Sn))

x≥y→x≮y : ∀ {m n} → N m → N n → GE m n → NLT m n
x≥y→x≮y zN          zN          _     = x≰x zN
x≥y→x≮y zN          (sN Nn)     0≥Sn  = ⊥-elim $ ¬0≥S Nn 0≥Sn
x≥y→x≮y (sN {m} Nm) zN          _     = <-S0 m
x≥y→x≮y (sN {m} Nm) (sN {n} Nn) Sm≥Sn =
  trans (<-SS m n) (x≥y→x≮y Nm Nn (trans (sym $ <-SS n (succ m)) Sm≥Sn))

x>y→x≰y : ∀ {m n} → N m → N n → GT m n → NLE m n
x>y→x≰y zN          Nn          0>m   = ⊥-elim $ ¬0>x Nn 0>m
x>y→x≰y (sN Nm)     zN          _     = S≰0 Nm
x>y→x≰y (sN {m} Nm) (sN {n} Nn) Sm>Sn =
  x≰y→Sx≰Sy m n (x>y→x≰y Nm Nn (trans (sym $ <-SS n m) Sm>Sn))

x>y∨x≤y : ∀ {m n} → N m → N n → GT m n ∨ LE m n
x>y∨x≤y zN          Nn          = inj₂ $ x≥0 Nn
x>y∨x≤y (sN {m} Nm) zN          = inj₁ $ <-0S m
x>y∨x≤y (sN {m} Nm) (sN {n} Nn) =
  [ (λ m>n → inj₁ (trans (<-SS n m) m>n))
  , (λ m≤n → inj₂ (x≤y→Sx≤Sy m≤n))
  ] (x>y∨x≤y Nm Nn)

x<y∨x≥y : ∀ {m n} → N m → N n → LT m n ∨ GE m n
x<y∨x≥y Nm Nn = x>y∨x≤y Nn Nm

x≤y∨x≰y : ∀ {m n} → N m → N n → LE m n ∨ NLE m n
x≤y∨x≰y zN Nn = inj₁ (0≤x Nn)
x≤y∨x≰y (sN Nm) zN = inj₂ (S≰0 Nm)
x≤y∨x≰y (sN {m} Nm) (sN {n} Nn) =
  [ (λ m≤n → inj₁ (x≤y→Sx≤Sy m≤n))
  , (λ m≰n → inj₂ (x≰y→Sx≰Sy m n m≰n))
  ] (x≤y∨x≰y Nm Nn)

x≡y→x≤y : ∀ {m n} {Nm : N m} {Nn : N n} → m ≡ n → LE m n
x≡y→x≤y {Nm = Nm} refl = x≤x Nm

x<y→x≤y : ∀ {m n} → N m → N n → LT m n → LE m n
x<y→x≤y Nm zN          m<0            = ⊥-elim $ ¬x<0 Nm m<0
x<y→x≤y zN (sN {n} Nn)          _     = <-0S $ succ n
x<y→x≤y (sN {m} Nm) (sN {n} Nn) Sm<Sn =
  x≤y→Sx≤Sy (x<y→x≤y Nm Nn (Sx<Sy→x<y Sm<Sn))

x<y→Sx≤y : ∀ {m n} → N m → N n → LT m n → LE (succ m) n
x<y→Sx≤y Nm          zN          m<0   = ⊥-elim $ ¬x<0 Nm m<0
x<y→Sx≤y zN          (sN Nn)     0<Sn  = x≤y→Sx≤Sy (0≤x Nn)
x<y→Sx≤y (sN {m} Nm) (sN {n} Nn) Sm<Sn = trans (<-SS (succ m) (succ n)) Sm<Sn

Sx≤y→x<y : ∀ {m n} → N m → N n → LE (succ m) n → LT m n
Sx≤y→x<y Nm          zN          Sm≤0   = ⊥-elim $ ¬S≤0 Nm Sm≤0
Sx≤y→x<y zN          (sN {n} Nn) _      = <-0S n
Sx≤y→x<y (sN {m} Nm) (sN {n} Nn) SSm≤Sn =
  x<y→Sx<Sy (Sx≤y→x<y Nm Nn (Sx≤Sy→x≤y SSm≤Sn))

<-trans : ∀ {m n o} → N m → N n → N o → LT m n → LT n o → LT m o
<-trans zN          zN          _           0<0   _     = ⊥-elim $ 0<0-elim 0<0
<-trans zN          (sN Nn)     zN          _     Sn<0  = ⊥-elim $ S<0-elim Sn<0
<-trans zN          (sN Nn)     (sN {o} No) _     _     = <-0S o
<-trans (sN Nm)     Nn          zN          _     n<0   = ⊥-elim $ ¬x<0 Nn n<0
<-trans (sN Nm)     zN          (sN No)     Sm<0  _     = ⊥-elim $ S<0-elim Sm<0
<-trans (sN {m} Nm) (sN {n} Nn) (sN {o} No) Sm<Sn Sn<So =
  x<y→Sx<Sy $ <-trans Nm Nn No (Sx<Sy→x<y Sm<Sn) (Sx<Sy→x<y Sn<So)

≤-trans : ∀ {m n o} → N m → N n → N o → LE m n → LE n o → LE m o
≤-trans zN      Nn              No          _     _     = 0≤x No
≤-trans (sN Nm) zN              No          Sm≤0  _     = ⊥-elim $ ¬S≤0 Nm Sm≤0
≤-trans (sN Nm) (sN Nn)         zN          _     Sn≤0  = ⊥-elim $ ¬S≤0 Nn Sn≤0
≤-trans (sN {m} Nm) (sN {n} Nn) (sN {o} No) Sm≤Sn Sn≤So =
  x≤y→Sx≤Sy (≤-trans Nm Nn No (Sx≤Sy→x≤y Sm≤Sn) (Sx≤Sy→x≤y Sn≤So))

x≤x+y : ∀ {m n} → N m → N n → LE m (m + n)
x≤x+y         zN          Nn = x≥0 (+-N zN Nn)
x≤x+y {n = n} (sN {m} Nm) Nn = prf $ x≤x+y Nm Nn
  where
    postulate prf : LE m (m + n) →  -- IH.
                    LE (succ m) (succ m + n)
    -- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
    {-# ATP prove prf #-}

x<x+Sy : ∀ {m n} → N m → N n → LT m (m + succ n)
x<x+Sy {n = n} zN Nn = prf0
  where
    postulate prf0 : LT zero (zero + succ n)
    {-# ATP prove prf0 #-}
x<x+Sy {n = n} (sN {m} Nm) Nn = prfS (x<x+Sy Nm Nn)
  where
    postulate prfS : LT m (m + succ n) → LT (succ m) (succ m + succ n)
    {-# ATP prove prfS #-}

x<y→Sx-y≡0 : ∀ {m n} → N m → N n → LT m n → succ m ∸ n ≡ zero
x<y→Sx-y≡0 Nm zN h = ⊥-elim (¬x<0 Nm h)
x<y→Sx-y≡0 zN (sN {n} Nn) h = prf0S
  where
    postulate prf0S : succ zero ∸ succ n ≡ zero
    {-# ATP prove prf0S ∸-0x #-}
x<y→Sx-y≡0 (sN {m} Nm) (sN {n} Nn) h = prfSS (x<y→Sx-y≡0 Nm Nn m<n)
  where
    postulate m<n : LT m n
    {-# ATP prove m<n #-}

    postulate prfSS : succ m ∸ n ≡ zero → succ (succ m) ∸ succ n ≡ zero
    {-# ATP prove prfSS #-}

x-y<Sx : ∀ {m n} → N m → N n → LT (m ∸ n) (succ m)
x-y<Sx {m} Nm zN = prf
  where
    postulate prf : LT (m ∸ zero) (succ m)
    {-# ATP prove prf x<Sx #-}

x-y<Sx zN (sN {n} Nn) = prf
  where
    postulate prf : LT (zero ∸ succ n) (succ zero)
    {-# ATP prove prf #-}

x-y<Sx (sN {m} Nm) (sN {n} Nn) = prf $ x-y<Sx Nm Nn
  where
    postulate prf : LT (m ∸ n) (succ m) →  -- IH.
                    LT (succ m ∸ succ n) (succ (succ m))
    -- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
    {-# ATP prove prf <-trans ∸-N x<Sx #-}  -- Use the hint sN.

postulate
  Sx-Sy<Sx : ∀ {m n} → N m → N n → LT (succ m ∸ succ n) (succ m)
{-# ATP prove Sx-Sy<Sx ∸-SS x-y<Sx #-}

x>y→x-y+y≡x : ∀ {m n} → N m → N n → GT m n → (m ∸ n) + n ≡ m
x>y→x-y+y≡x zN          Nn 0>n  = ⊥-elim $ ¬0>x Nn 0>n
x>y→x-y+y≡x (sN {m} Nm) zN Sm>0 = prf
  where
    postulate prf : (succ m ∸ zero) + zero ≡ succ m
    {-# ATP prove prf +-rightIdentity ∸-N #-}

x>y→x-y+y≡x (sN {m} Nm) (sN {n} Nn) Sm>Sn = prf $ x>y→x-y+y≡x Nm Nn m>n
  where
    postulate m>n : GT m n
    {-# ATP prove m>n #-}

    postulate prf : (m ∸ n) + n ≡ m →  -- IH.
                    (succ m ∸ succ n) + succ n ≡ succ m
    -- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
    -- Vampire 0.6 (revision 903): No-success (using timeout 180 sec).
    {-# ATP prove prf +-comm ∸-N #-}  -- Use the hint sN.

x≤y→y-x+x≡y : ∀ {m n} → N m → N n → LE m n → (n ∸ m) + m ≡ n
x≤y→y-x+x≡y {n = n} zN Nn 0≤n  = prf
  where
    postulate prf : (n ∸ zero) + zero ≡ n
    {-# ATP prove prf +-rightIdentity ∸-N #-}

x≤y→y-x+x≡y (sN Nm) zN Sm≤0 = ⊥-elim $ ¬S≤0 Nm Sm≤0

x≤y→y-x+x≡y (sN {m} Nm) (sN {n} Nn) Sm≤Sn = prf $ x≤y→y-x+x≡y Nm Nn m≤n
  where
    postulate m≤n : LE m n
    {-# ATP prove m≤n #-}

    postulate prf : (n ∸ m) + m ≡ n →  -- IH.
                    (succ n ∸ succ m) + succ m ≡ succ n
    -- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
    -- Vampire 0.6 (revision 903): No-success (using timeout 180 sec).
    {-# ATP prove prf +-comm ∸-N #-}  -- Use the hint sN.

x<y→x<Sy : ∀ {m n} → N m → N n → LT m n → LT m (succ n)
x<y→x<Sy Nm          zN          m<0   = ⊥-elim $ ¬x<0 Nm m<0
x<y→x<Sy zN          (sN {n} Nn) 0<Sn  = <-0S $ succ n
x<y→x<Sy (sN {m} Nm) (sN {n} Nn) Sm<Sn =
  x<y→Sx<Sy (x<y→x<Sy Nm Nn (Sx<Sy→x<y Sm<Sn))

x<Sy→x<y∨x≡y : ∀ {m n} → N m → N n → LT m (succ n) → LT m n ∨ m ≡ n
x<Sy→x<y∨x≡y zN zN 0<S0 = inj₂ refl
x<Sy→x<y∨x≡y zN (sN {n} Nn) 0<SSn = inj₁ (<-0S n)
x<Sy→x<y∨x≡y (sN {m} Nm) zN Sm<S0 =
  ⊥-elim $ ¬x<0 Nm (trans (sym $ <-SS m zero) Sm<S0)
x<Sy→x<y∨x≡y (sN {m} Nm) (sN {n} Nn) Sm<SSn =
  [ (λ m<n → inj₁ (trans (<-SS m n) m<n))
  , (λ m≡n → inj₂ (x≡y→Sx≡Sy m≡n))
  ]
  m<n∨m≡n

  where
    m<n∨m≡n : LT m n ∨ m ≡ n
    m<n∨m≡n = x<Sy→x<y∨x≡y Nm Nn (trans (sym $ <-SS m (succ n)) Sm<SSn)

postulate
  x<y→y≡z→x<z : ∀ {m n o} → N m → N n → N o → LT m n → n ≡ o → LT m o
{-# ATP prove x<y→y≡z→x<z #-}

postulate
  x≡y→y<z→x<z : ∀ {m n o} → N m → N n → N o → m ≡ n → LT n o → LT m o
{-# ATP prove x≡y→y<z→x<z #-}

x≥y→y>0→x-y<x : ∀ {m n} → N m → N n → GE m n → GT n zero → LT (m ∸ n) m
x≥y→y>0→x-y<x Nm          zN          _     0>0  = ⊥-elim $ ¬x>x zN 0>0
x≥y→y>0→x-y<x zN          (sN Nn)     0≥Sn  _    = ⊥-elim $ ¬S≤0 Nn 0≥Sn
x≥y→y>0→x-y<x (sN {m} Nm) (sN {n} Nn) Sm≥Sn Sn>0 = prf
  where
    postulate prf : LT (succ m ∸ succ n) (succ m)
    {-# ATP prove prf x-y<Sx #-}

x<y→y≤z→x<z : ∀ {m n o} → N m → N n → N o → LT m n → LE n o → LT m o
x<y→y≤z→x<z Nm Nn No m<n n≤o =
  [ (λ n<o → <-trans Nm Nn No m<n n<o)
  , (λ n≡o → aux m<n n≡o)
  ] (x<Sy→x<y∨x≡y Nn No n≤o)
  where
    aux : ∀ {a b c} → LT a b → b ≡ c → LT a c
    aux a<b refl = a<b

x≤y+x-y : ∀ {m n} → N m → N n → LE m (n + (m ∸ n))
x≤y+x-y {n = n} zN Nn = prf0
  where postulate prf0 : LE zero (n + (zero ∸ n))
        {-# ATP prove prf0 0≤x +-N  #-}
x≤y+x-y (sN {m} Nm) zN = prfx0
  where postulate prfx0 : LE (succ m) (zero + (succ m ∸ zero))
        {-# ATP prove prfx0 x<Sx #-}
x≤y+x-y (sN {m} Nm) (sN {n} Nn) = prfSS (x≤y+x-y Nm Nn)
  where postulate prfSS : LE m (n + (m ∸ n)) →  -- IH.
                          LE (succ m) (succ n + (succ m ∸ succ n))
        {-# ATP prove prfSS x≤y→Sx≤Sy ≤-trans +-N ∸-N #-}

------------------------------------------------------------------------------
-- Properties about LT₂

postulate
  ¬xy<00 : ∀ {m n} → N m → N n → ¬ (LT₂ m n zero zero)
-- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
{-# ATP prove ¬xy<00 ¬x<0 #-}

postulate
  ¬Sxy₁<0y₂ : ∀ {m n₁ n₂} → N m → N n₁ → N n₂ → ¬ (LT₂ (succ m) n₁ zero n₂)
-- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
{-# ATP prove ¬Sxy₁<0y₂ ¬x<0 #-}  -- Use the hint sN.

postulate
  ¬0Sx<00 : ∀ {m} → N m → ¬ (LT₂ zero (succ m) zero zero)
-- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
{-# ATP prove ¬0Sx<00 ¬x<0 #-}  -- Use the hint sN.

postulate
  x₁y<x₂0→x₁<x₂ : ∀ {m₁ n m₂} → N m₁ → N n → N m₂ → LT₂ m₁ n m₂ zero → LT m₁ m₂
-- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
{-# ATP prove x₁y<x₂0→x₁<x₂ ¬x<0 #-}

postulate
  xy₁<0y₂→x≡0∧y₁<y₂ : ∀ {m n₁ n₂} → N m → N n₁ → N n₂ → LT₂ m n₁ zero n₂ →
                      m ≡ zero ∧ LT n₁ n₂
-- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
{-# ATP prove xy₁<0y₂→x≡0∧y₁<y₂ ¬x<0 #-}

[Sx-Sy,Sy]<[Sx,Sy] : ∀ {m n} → N m → N n →
                     LT₂ (succ m ∸ succ n) (succ n) (succ m) (succ n)
[Sx-Sy,Sy]<[Sx,Sy] {m} {n} Nm Nn = prf
  where
    postulate prf : LT₂ (succ m ∸ succ n) (succ n) (succ m) (succ n)
    -- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
    {-# ATP prove prf x-y<Sx #-}  -- Use the hint sN.

[Sx,Sy-Sx]<[Sx,Sy] : ∀ {m n} → N m → N n →
                     LT₂ (succ m) (succ n ∸ succ m) (succ m) (succ n)
[Sx,Sy-Sx]<[Sx,Sy] {m} {n} Nm Nn = prf
  where
    postulate prf : LT₂ (succ m) (succ n ∸ succ m) (succ m) (succ n)
    -- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
    {-# ATP prove prf x-y<Sx #-}  -- Use the hint sN.

------------------------------------------------------------------------------
-- Properties of the inequalities
------------------------------------------------------------------------------

module LTC.Data.Nat.Inequalities.PropertiesATP where

open import LTC.Base
open import LTC.Base.Properties using ( x≡y→Sx≡Sy )

open import Common.Function using ( _$_ )

open import LTC.Data.Nat
  using ( _+_ ; _∸_ ; ∸-SS
        ; N ; sN ; zN  -- The LTC natural numbers type
        )
open import LTC.Data.Nat.Inequalities
  using ( <-00 ; <-0S ; <-S0 ; <-SS
        ; GE ; GT ; LE ; LT ; NGT ; NLE ; NLT
        ; LT₂
        )
open import LTC.Data.Nat.PropertiesATP
  using ( +-N ; ∸-N
        ; +-comm
        ; +-rightIdentity
        )

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

0<0-elim : LT zero zero → ⊥
0<0-elim 0<0 = true≠false $ trans (sym 0<0) <-00

S<0-elim : {d : D} → LT (succ d) zero → ⊥
S<0-elim {d} Sd<0 = true≠false $ trans (sym Sd<0) (<-S0 d)

x≥0 : ∀ {n} → N n → GE n zero
x≥0 zN          = <-0S zero
x≥0 (sN {n} Nn) = <-0S $ succ n

0≤x : ∀ {n} → N n → LE zero n
0≤x Nn = x≥0 Nn

¬x<0 : ∀ {n} → N n → ¬ (LT n zero)
¬x<0 zN      0<0  = 0<0-elim 0<0
¬x<0 (sN Nn) Sn<0 = S<0-elim Sn<0

0≯x : ∀ {n} → N n → NGT zero n
0≯x zN          = <-00
0≯x (sN {n} Nn) = <-S0 n

postulate
  ¬0>x : ∀ {n} → N n → ¬ (GT zero n)
{-# ATP prove ¬0>x 0≯x #-}

x≰x : ∀ {n} → N n → NLT n n
x≰x zN          = <-00
x≰x (sN {n} Nn) = trans (<-SS n n) (x≰x Nn)

S≰0 : ∀ {n} → N n → NLE (succ n) zero
S≰0 zN          = x≰x (sN zN)
S≰0 (sN {n} Nn) = trans (<-SS (succ n) zero) (<-S0 n)

¬S≤0 : ∀ {n} → N n → ¬ (LE (succ n) zero)
¬S≤0 {d} Nn Sn≤0 = true≠false $ trans (sym Sn≤0) (S≰0 Nn)

¬0≥S : ∀ {n} → N n → ¬ (GE zero (succ n))
¬0≥S Nn 0≥Sn = ¬S≤0 Nn 0≥Sn

x<Sx : ∀ {n} → N n → LT n (succ n)
x<Sx zN          = <-0S zero
x<Sx (sN {n} Nn) = trans (<-SS n (succ n)) (x<Sx Nn)

postulate
  x<y→Sx<Sy : ∀ {m n} → LT m n → LT (succ m) (succ n)
{-# ATP prove x<y→Sx<Sy #-}

postulate
  Sx<Sy→x<y : ∀ {m n} → LT (succ m) (succ n) → LT m n
{-# ATP prove Sx<Sy→x<y #-}

¬x<x : ∀ {n} → N n → ¬ (LT n n)
¬x<x zN           0<0  = 0<0-elim 0<0
¬x<x (sN {n} Nn) Sn<Sn = ⊥-elim $ ¬x<x Nn (trans (sym $ <-SS n n) Sn<Sn)

¬x>x : ∀ {n} → N n → ¬ (GT n n)
¬x>x Nn = ¬x<x Nn

x≤x : ∀ {n} → N n → LE n n
x≤x zN          = <-0S zero
x≤x (sN {n} Nn) = trans (<-SS n (succ n)) (x≤x Nn)

x≤y→Sx≤Sy : ∀ {m n} → LE m n → LE (succ m) (succ n)
x≤y→Sx≤Sy {m} {n} m≤n = trans (<-SS m (succ n)) m≤n

postulate
  Sx≤Sy→x≤y : ∀ {m n} → LE (succ m) (succ n) → LE m n
{-# ATP prove Sx≤Sy→x≤y #-}

x≰y→Sx≰Sy : ∀ m n → NLE m n → NLE (succ m) (succ n)
x≰y→Sx≰Sy m n m≰n = trans (<-SS m (succ n)) m≰n

x>y→y<x : ∀ {m n} → N m → N n → GT m n → LT n m
x>y→y<x zN          Nn          0>n   = ⊥-elim $ ¬0>x Nn 0>n
x>y→y<x (sN {m} Nm) zN          _     = <-0S m
x>y→y<x (sN {m} Nm) (sN {n} Nn) Sm>Sn =
  trans (<-SS n m) (x>y→y<x Nm Nn (trans (sym $ <-SS n m) Sm>Sn))

x≥y→x≮y : ∀ {m n} → N m → N n → GE m n → NLT m n
x≥y→x≮y zN          zN          _     = x≰x zN
x≥y→x≮y zN          (sN Nn)     0≥Sn  = ⊥-elim $ ¬0≥S Nn 0≥Sn
x≥y→x≮y (sN {m} Nm) zN          _     = <-S0 m
x≥y→x≮y (sN {m} Nm) (sN {n} Nn) Sm≥Sn =
  trans (<-SS m n) (x≥y→x≮y Nm Nn (trans (sym $ <-SS n (succ m)) Sm≥Sn))

x>y→x≰y : ∀ {m n} → N m → N n → GT m n → NLE m n
x>y→x≰y zN          Nn          0>m   = ⊥-elim $ ¬0>x Nn 0>m
x>y→x≰y (sN Nm)     zN          _     = S≰0 Nm
x>y→x≰y (sN {m} Nm) (sN {n} Nn) Sm>Sn =
  x≰y→Sx≰Sy m n (x>y→x≰y Nm Nn (trans (sym $ <-SS n m) Sm>Sn))

x>y∨x≤y : ∀ {m n} → N m → N n → GT m n ∨ LE m n
x>y∨x≤y zN          Nn          = inj₂ $ x≥0 Nn
x>y∨x≤y (sN {m} Nm) zN          = inj₁ $ <-0S m
x>y∨x≤y (sN {m} Nm) (sN {n} Nn) =
  [ (λ m>n → inj₁ (trans (<-SS n m) m>n))
  , (λ m≤n → inj₂ (x≤y→Sx≤Sy m≤n))
  ] (x>y∨x≤y Nm Nn)

x<y∨x≥y : ∀ {m n} → N m → N n → LT m n ∨ GE m n
x<y∨x≥y Nm Nn = x>y∨x≤y Nn Nm

x≤y∨x≰y : ∀ {m n} → N m → N n → LE m n ∨ NLE m n
x≤y∨x≰y zN Nn = inj₁ (0≤x Nn)
x≤y∨x≰y (sN Nm) zN = inj₂ (S≰0 Nm)
x≤y∨x≰y (sN {m} Nm) (sN {n} Nn) =
  [ (λ m≤n → inj₁ (x≤y→Sx≤Sy m≤n))
  , (λ m≰n → inj₂ (x≰y→Sx≰Sy m n m≰n))
  ] (x≤y∨x≰y Nm Nn)

x≡y→x≤y : ∀ {m n} {Nm : N m} {Nn : N n} → m ≡ n → LE m n
x≡y→x≤y {Nm = Nm} refl = x≤x Nm

x<y→x≤y : ∀ {m n} → N m → N n → LT m n → LE m n
x<y→x≤y Nm zN          m<0            = ⊥-elim $ ¬x<0 Nm m<0
x<y→x≤y zN (sN {n} Nn)          _     = <-0S $ succ n
x<y→x≤y (sN {m} Nm) (sN {n} Nn) Sm<Sn =
  x≤y→Sx≤Sy (x<y→x≤y Nm Nn (Sx<Sy→x<y Sm<Sn))

x<y→Sx≤y : ∀ {m n} → N m → N n → LT m n → LE (succ m) n
x<y→Sx≤y Nm          zN          m<0   = ⊥-elim $ ¬x<0 Nm m<0
x<y→Sx≤y zN          (sN Nn)     0<Sn  = x≤y→Sx≤Sy (0≤x Nn)
x<y→Sx≤y (sN {m} Nm) (sN {n} Nn) Sm<Sn = trans (<-SS (succ m) (succ n)) Sm<Sn

Sx≤y→x<y : ∀ {m n} → N m → N n → LE (succ m) n → LT m n
Sx≤y→x<y Nm          zN          Sm≤0   = ⊥-elim $ ¬S≤0 Nm Sm≤0
Sx≤y→x<y zN          (sN {n} Nn) _      = <-0S n
Sx≤y→x<y (sN {m} Nm) (sN {n} Nn) SSm≤Sn =
  x<y→Sx<Sy (Sx≤y→x<y Nm Nn (Sx≤Sy→x≤y SSm≤Sn))

<-trans : ∀ {m n o} → N m → N n → N o → LT m n → LT n o → LT m o
<-trans zN          zN          _           0<0   _     = ⊥-elim $ 0<0-elim 0<0
<-trans zN          (sN Nn)     zN          _     Sn<0  = ⊥-elim $ S<0-elim Sn<0
<-trans zN          (sN Nn)     (sN {o} No) _     _     = <-0S o
<-trans (sN Nm)     Nn          zN          _     n<0   = ⊥-elim $ ¬x<0 Nn n<0
<-trans (sN Nm)     zN          (sN No)     Sm<0  _     = ⊥-elim $ S<0-elim Sm<0
<-trans (sN {m} Nm) (sN {n} Nn) (sN {o} No) Sm<Sn Sn<So =
  x<y→Sx<Sy $ <-trans Nm Nn No (Sx<Sy→x<y Sm<Sn) (Sx<Sy→x<y Sn<So)

≤-trans : ∀ {m n o} → N m → N n → N o → LE m n → LE n o → LE m o
≤-trans zN      Nn              No          _     _     = 0≤x No
≤-trans (sN Nm) zN              No          Sm≤0  _     = ⊥-elim $ ¬S≤0 Nm Sm≤0
≤-trans (sN Nm) (sN Nn)         zN          _     Sn≤0  = ⊥-elim $ ¬S≤0 Nn Sn≤0
≤-trans (sN {m} Nm) (sN {n} Nn) (sN {o} No) Sm≤Sn Sn≤So =
  x≤y→Sx≤Sy (≤-trans Nm Nn No (Sx≤Sy→x≤y Sm≤Sn) (Sx≤Sy→x≤y Sn≤So))

x≤x+y : ∀ {m n} → N m → N n → LE m (m + n)
x≤x+y         zN          Nn = x≥0 (+-N zN Nn)
x≤x+y {n = n} (sN {m} Nm) Nn = prf $ x≤x+y Nm Nn
  where
    postulate prf : LE m (m + n) →  -- IH.
                    LE (succ m) (succ m + n)
    -- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
    {-# ATP prove prf #-}

x<x+Sy : ∀ {m n} → N m → N n → LT m (m + succ n)
x<x+Sy {n = n} zN Nn = prf0
  where
    postulate prf0 : LT zero (zero + succ n)
    {-# ATP prove prf0 #-}
x<x+Sy {n = n} (sN {m} Nm) Nn = prfS (x<x+Sy Nm Nn)
  where
    postulate prfS : LT m (m + succ n) → LT (succ m) (succ m + succ n)
    {-# ATP prove prfS #-}

x-y<Sx : ∀ {m n} → N m → N n → LT (m ∸ n) (succ m)
x-y<Sx {m} Nm zN = prf
  where
    postulate prf : LT (m ∸ zero) (succ m)
    {-# ATP prove prf x<Sx #-}

x-y<Sx zN (sN {n} Nn) = prf
  where
    postulate prf : LT (zero ∸ succ n) (succ zero)
    {-# ATP prove prf #-}

x-y<Sx (sN {m} Nm) (sN {n} Nn) = prf $ x-y<Sx Nm Nn
  where
    postulate prf : LT (m ∸ n) (succ m) →  -- IH.
                    LT (succ m ∸ succ n) (succ (succ m))
    -- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
    {-# ATP prove prf <-trans ∸-N x<Sx #-}  -- Use the hint sN.

postulate
  Sx-Sy<Sx : ∀ {m n} → N m → N n → LT (succ m ∸ succ n) (succ m)
{-# ATP prove Sx-Sy<Sx ∸-SS x-y<Sx #-}

x>y→x-y+y≡x : ∀ {m n} → N m → N n → GT m n → (m ∸ n) + n ≡ m
x>y→x-y+y≡x zN          Nn 0>n  = ⊥-elim $ ¬0>x Nn 0>n
x>y→x-y+y≡x (sN {m} Nm) zN Sm>0 = prf
  where
    postulate prf : (succ m ∸ zero) + zero ≡ succ m
    {-# ATP prove prf +-rightIdentity ∸-N #-}

x>y→x-y+y≡x (sN {m} Nm) (sN {n} Nn) Sm>Sn = prf $ x>y→x-y+y≡x Nm Nn m>n
  where
    postulate m>n : GT m n
    {-# ATP prove m>n #-}

    postulate prf : (m ∸ n) + n ≡ m →  -- IH.
                    (succ m ∸ succ n) + succ n ≡ succ m
    -- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
    -- Vampire 0.6 (revision 903): No-success (using timeout 180 sec).
    {-# ATP prove prf +-comm ∸-N #-}  -- Use the hint sN.

x≤y→y-x+x≡y : ∀ {m n} → N m → N n → LE m n → (n ∸ m) + m ≡ n
x≤y→y-x+x≡y {n = n} zN Nn 0≤n  = prf
  where
    postulate prf : (n ∸ zero) + zero ≡ n
    {-# ATP prove prf +-rightIdentity ∸-N #-}

x≤y→y-x+x≡y (sN Nm) zN Sm≤0 = ⊥-elim $ ¬S≤0 Nm Sm≤0

x≤y→y-x+x≡y (sN {m} Nm) (sN {n} Nn) Sm≤Sn = prf $ x≤y→y-x+x≡y Nm Nn m≤n
  where
    postulate m≤n : LE m n
    {-# ATP prove m≤n #-}

    postulate prf : (n ∸ m) + m ≡ n →  -- IH.
                    (succ n ∸ succ m) + succ m ≡ succ n
    -- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
    -- Vampire 0.6 (revision 903): No-success (using timeout 180 sec).
    {-# ATP prove prf +-comm ∸-N #-}  -- Use the hint sN.

x<y→x<Sy : ∀ {m n} → N m → N n → LT m n → LT m (succ n)
x<y→x<Sy Nm          zN          m<0   = ⊥-elim $ ¬x<0 Nm m<0
x<y→x<Sy zN          (sN {n} Nn) 0<Sn  = <-0S $ succ n
x<y→x<Sy (sN {m} Nm) (sN {n} Nn) Sm<Sn =
  x<y→Sx<Sy (x<y→x<Sy Nm Nn (Sx<Sy→x<y Sm<Sn))

x<Sy→x<y∨x≡y : ∀ {m n} → N m → N n → LT m (succ n) → LT m n ∨ m ≡ n
x<Sy→x<y∨x≡y zN zN 0<S0 = inj₂ refl
x<Sy→x<y∨x≡y zN (sN {n} Nn) 0<SSn = inj₁ (<-0S n)
x<Sy→x<y∨x≡y (sN {m} Nm) zN Sm<S0 =
  ⊥-elim $ ¬x<0 Nm (trans (sym $ <-SS m zero) Sm<S0)
x<Sy→x<y∨x≡y (sN {m} Nm) (sN {n} Nn) Sm<SSn =
  [ (λ m<n → inj₁ (trans (<-SS m n) m<n))
  , (λ m≡n → inj₂ (x≡y→Sx≡Sy m≡n))
  ]
  m<n∨m≡n

  where
    m<n∨m≡n : LT m n ∨ m ≡ n
    m<n∨m≡n = x<Sy→x<y∨x≡y Nm Nn (trans (sym $ <-SS m (succ n)) Sm<SSn)

postulate
  x<y→y≡z→x<z : ∀ {m n o} → N m → N n → N o → LT m n → n ≡ o → LT m o
{-# ATP prove x<y→y≡z→x<z #-}

postulate
  x≡y→y<z→x<z : ∀ {m n o} → N m → N n → N o → m ≡ n → LT n o → LT m o
{-# ATP prove x≡y→y<z→x<z #-}

x≥y→y>0→x-y<x : ∀ {m n} → N m → N n → GE m n → GT n zero → LT (m ∸ n) m
x≥y→y>0→x-y<x Nm          zN          _     0>0  = ⊥-elim $ ¬x>x zN 0>0
x≥y→y>0→x-y<x zN          (sN Nn)     0≥Sn  _    = ⊥-elim $ ¬S≤0 Nn 0≥Sn
x≥y→y>0→x-y<x (sN {m} Nm) (sN {n} Nn) Sm≥Sn Sn>0 = prf
  where
    postulate prf : LT (succ m ∸ succ n) (succ m)
    {-# ATP prove prf x-y<Sx #-}

x<y→y≤z→x<z : ∀ {m n o} → N m → N n → N o → LT m n → LE n o → LT m o
x<y→y≤z→x<z Nm Nn No m<n n≤o =
  [ (λ n<o → <-trans Nm Nn No m<n n<o)
  , (λ n≡o → aux m<n n≡o)
  ] (x<Sy→x<y∨x≡y Nn No n≤o)
  where
    aux : ∀ {a b c} → LT a b → b ≡ c → LT a c
    aux a<b refl = a<b

x≤y+x-y : ∀ {m n} → N m → N n → LE m (n + (m ∸ n))
x≤y+x-y {n = n} zN Nn = prf0
  where postulate prf0 : LE zero (n + (zero ∸ n))
        {-# ATP prove prf0 0≤x +-N  #-}
x≤y+x-y (sN {m} Nm) zN = prfx0
  where postulate prfx0 : LE (succ m) (zero + (succ m ∸ zero))
        {-# ATP prove prfx0 x<Sx #-}
x≤y+x-y (sN {m} Nm) (sN {n} Nn) = prfSS (x≤y+x-y Nm Nn)
  where postulate prfSS : LE m (n + (m ∸ n)) →  -- IH.
                          LE (succ m) (succ n + (succ m ∸ succ n))
        {-# ATP prove prfSS x≤y→Sx≤Sy ≤-trans +-N ∸-N #-}

------------------------------------------------------------------------------
-- Properties about LT₂

postulate
  ¬xy<00 : ∀ {m n} → N m → N n → ¬ (LT₂ m n zero zero)
-- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
{-# ATP prove ¬xy<00 ¬x<0 #-}

postulate
  ¬Sxy₁<0y₂ : ∀ {m n₁ n₂} → N m → N n₁ → N n₂ → ¬ (LT₂ (succ m) n₁ zero n₂)
-- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
{-# ATP prove ¬Sxy₁<0y₂ ¬x<0 #-}  -- Use the hint sN.

postulate
  ¬0Sx<00 : ∀ {m} → N m → ¬ (LT₂ zero (succ m) zero zero)
-- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
{-# ATP prove ¬0Sx<00 ¬x<0 #-}  -- Use the hint sN.

postulate
  x₁y<x₂0→x₁<x₂ : ∀ {m₁ n m₂} → N m₁ → N n → N m₂ → LT₂ m₁ n m₂ zero → LT m₁ m₂
-- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
{-# ATP prove x₁y<x₂0→x₁<x₂ ¬x<0 #-}

postulate
  xy₁<0y₂→x≡0∧y₁<y₂ : ∀ {m n₁ n₂} → N m → N n₁ → N n₂ → LT₂ m n₁ zero n₂ →
                      m ≡ zero ∧ LT n₁ n₂
-- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
{-# ATP prove xy₁<0y₂→x≡0∧y₁<y₂ ¬x<0 #-}

[Sx-Sy,Sy]<[Sx,Sy] : ∀ {m n} → N m → N n →
                     LT₂ (succ m ∸ succ n) (succ n) (succ m) (succ n)
[Sx-Sy,Sy]<[Sx,Sy] {m} {n} Nm Nn = prf
  where
    postulate prf : LT₂ (succ m ∸ succ n) (succ n) (succ m) (succ n)
    -- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
    {-# ATP prove prf x-y<Sx #-}  -- Use the hint sN.

[Sx,Sy-Sx]<[Sx,Sy] : ∀ {m n} → N m → N n →
                     LT₂ (succ m) (succ n ∸ succ m) (succ m) (succ n)
[Sx,Sy-Sx]<[Sx,Sy] {m} {n} Nm Nn = prf
  where
    postulate prf : LT₂ (succ m) (succ n ∸ succ m) (succ m) (succ n)
    -- Metis 2.3 (release 20101019): SZS status Unknown (using timeout 180 sec).
    {-# ATP prove prf x-y<Sx #-}  -- Use the hint sN.


RenderToHTML.agda: Cleaning.

RenderToHTML.agda: Cleaning.


Map / fold for ind

Map / fold for ind


Added succCong and predCong.

Added succCong and predCong.

Ignore-this: b4c73cd153958f7ba9fc0d4e83461efc

darcs-hash:20120602040222-3bd4e-9bac12b25b9f6fecd7824a3f3f73118599725822.gz

------------------------------------------------------------------------------
-- Arithmetic properties
------------------------------------------------------------------------------

{-# OPTIONS --no-universe-polymorphism #-}
{-# OPTIONS --without-K #-}

module LTC-PCF.Data.Nat.PropertiesI where

open import Common.FOL.Relation.Binary.EqReasoning

open import LTC-PCF.Base
open import LTC-PCF.Base.Properties
open import LTC-PCF.Data.Nat
open import LTC-PCF.Data.Nat.Rec
open import LTC-PCF.Data.Nat.Rec.EquationsI

------------------------------------------------------------------------------
-- Congruence properties

succCong : ∀ {m n} → m ≡ n → succ₁ m ≡ succ₁ n
succCong refl = refl

predCong : ∀ {m n} → m ≡ n → pred₁ m ≡ pred₁ n
predCong refl = refl

+-leftCong : ∀ {m n o} → m ≡ n → m + o ≡ n + o
+-leftCong refl = refl

+-rightCong : ∀ {m n o} → n ≡ o → m + n ≡ m + o
+-rightCong refl = refl

∸-leftCong : ∀ {m n o} → m ≡ n → m ∸ o ≡ n ∸ o
∸-leftCong refl = refl

∸-rightCong : ∀ {m n o} → n ≡ o → m ∸ n ≡ m ∸ o
∸-rightCong refl = refl

*-leftCong : ∀ {m n o} → m ≡ n → m * o ≡ n * o
*-leftCong refl = refl

*-rightCong : ∀ {m n o} → n ≡ o → m * n ≡ m * o
*-rightCong refl = refl

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

+-0x : ∀ n → zero + n ≡ n
+-0x n = rec zero n _ ≡⟨ rec-0 n ⟩
         n            ∎

+-Sx : ∀ m n → succ₁ m + n ≡ succ₁ (m + n)
+-Sx m n =
  rec (succ₁ m) n (lam (λ x → lam (λ y → succ₁ y)))
    ≡⟨ rec-S m n (lam (λ x → lam (λ y → succ₁ y))) ⟩
  (lam (λ x → lam (λ y → succ₁ y))) · m · (m + n)
    ≡⟨ ·-leftCong (beta (λ x → lam (λ y → succ₁ y)) m) ⟩
  (λ x → lam (λ y → succ₁ y)) m · (m + n)
    ≡⟨ refl ⟩
  lam succ₁ · (m + n)
    ≡⟨ beta succ₁ (m + n) ⟩
  succ₁ (m + n) ∎

∸-x0 : ∀ n → n ∸ zero ≡ n
∸-x0 n = rec zero n _ ≡⟨ rec-0 n ⟩
         n            ∎

∸-0S : ∀ {n} → N n → zero ∸ succ₁ n ≡ zero
∸-0S zN =
  rec (succ₁ zero) zero (lam (λ x → lam (λ y → pred₁ y)))
    ≡⟨ rec-S zero zero (lam (λ x → lam (λ y → pred₁ y))) ⟩
  lam (λ x → lam (λ y → pred₁ y)) · zero · (zero ∸ zero)
    ≡⟨ ·-leftCong (beta (λ x → lam (λ y → pred₁ y)) zero) ⟩
  (λ x → lam (λ y → pred₁ y)) zero · (zero ∸ zero)
    ≡⟨ refl ⟩
  lam pred₁ · (zero ∸ zero)
    ≡⟨ beta pred₁ (zero ∸ zero) ⟩
  pred₁ (zero ∸ zero)
    ≡⟨ predCong (∸-x0 zero) ⟩
  pred₁ zero
    ≡⟨ pred-0 ⟩
  zero ∎

∸-0S (sN {n} Nn) =
  rec (succ₁ (succ₁ n)) zero (lam (λ x → lam (λ y → pred₁ y)))
    ≡⟨ rec-S (succ₁ n) zero (lam (λ x → lam (λ y → pred₁ y))) ⟩
  lam (λ x → lam (λ y → pred₁ y)) · (succ₁ n) · (zero ∸ (succ₁ n))
    ≡⟨ ·-leftCong (beta (λ x → lam (λ y → pred₁ y)) (succ₁ n)) ⟩
  (λ x → lam (λ y → pred₁ y))  (succ₁ n) · (zero ∸ (succ₁ n))
    ≡⟨ refl ⟩
  lam pred₁ · (zero ∸ (succ₁ n))
    ≡⟨ beta pred₁ (zero ∸ (succ₁ n)) ⟩
  pred₁ (zero ∸ (succ₁ n))
    ≡⟨ predCong (∸-0S Nn) ⟩
  pred₁ zero
    ≡⟨ pred-0 ⟩
  zero ∎

∸-0x : ∀ {n} → N n → zero ∸ n ≡ zero
∸-0x zN      = ∸-x0 zero
∸-0x (sN Nn) = ∸-0S Nn

∸-SS : ∀ {m n} → N m → N n → succ₁ m ∸ succ₁ n ≡ m ∸ n
∸-SS {m} _ zN =
  rec (succ₁ zero) (succ₁ m) (lam (λ x → lam (λ y → pred₁ y)))
    ≡⟨ rec-S zero (succ₁ m) (lam (λ x → lam (λ y → pred₁ y))) ⟩
  lam (λ x → lam (λ y → pred₁ y))  · zero · (succ₁ m ∸ zero)
    ≡⟨ ·-leftCong (beta (λ x → lam (λ y → pred₁ y)) zero) ⟩
  (λ x → lam (λ y → pred₁ y)) zero · (succ₁ m ∸ zero)
    ≡⟨ refl ⟩
  lam pred₁ · (succ₁ m ∸ zero)
    ≡⟨ beta pred₁ (succ₁ m ∸ zero) ⟩
  pred₁ (succ₁ m ∸ zero)
    ≡⟨ predCong (∸-x0 (succ₁ m)) ⟩
  pred₁ (succ₁ m)
    ≡⟨ pred-S m ⟩
  m
    ≡⟨ sym (∸-x0 m) ⟩
  m ∸ zero ∎

∸-SS zN (sN {n} Nn) =
  rec (succ₁ (succ₁ n)) (succ₁ zero) (lam (λ x → lam (λ y → pred₁ y)))
    ≡⟨ rec-S (succ₁ n) (succ₁ zero) (lam (λ x → lam (λ y → pred₁ y)))  ⟩
  lam (λ x → lam (λ y → pred₁ y)) · (succ₁ n) · (succ₁ zero ∸ succ₁ n)
    ≡⟨ ·-leftCong (beta (λ x → lam (λ y → pred₁ y)) (succ₁ n)) ⟩
  (λ x → lam (λ y → pred₁ y)) (succ₁ n) · (succ₁ zero ∸ succ₁ n)
    ≡⟨ refl ⟩
  lam pred₁ · (succ₁ zero ∸ succ₁ n)
    ≡⟨ beta pred₁ (succ₁ zero ∸ succ₁ n) ⟩
  pred₁ (succ₁ zero ∸ succ₁ n)
    ≡⟨ predCong (∸-SS zN Nn) ⟩
  pred₁ (zero ∸ n)
    ≡⟨ predCong (∸-0x Nn) ⟩
  pred₁ zero
    ≡⟨ pred-0 ⟩
  zero
    ≡⟨ sym (∸-0S Nn) ⟩
  zero ∸ succ₁ n ∎

∸-SS (sN {m} Nm) (sN {n} Nn) =
  rec (succ₁ (succ₁ n)) (succ₁ (succ₁ m)) (lam (λ x → lam (λ y → pred₁ y)))
    ≡⟨ rec-S (succ₁ n) (succ₁ (succ₁ m)) (lam (λ x → lam (λ y → pred₁ y))) ⟩
  lam (λ x → lam (λ y → pred₁ y)) · (succ₁ n) · (succ₁ (succ₁ m) ∸ succ₁ n)
    ≡⟨ ·-leftCong (beta (λ x → lam (λ y → pred₁ y)) (succ₁ n)) ⟩
  (λ x → lam (λ y → pred₁ y)) (succ₁ n) · (succ₁ (succ₁ m) ∸ succ₁ n)
    ≡⟨ refl ⟩
  lam pred₁ · (succ₁ (succ₁ m) ∸ succ₁ n)
    ≡⟨ beta pred₁ (succ₁ (succ₁ m) ∸ succ₁ n) ⟩
  pred₁ (succ₁ (succ₁ m) ∸ succ₁ n)
    ≡⟨ predCong (∸-SS (sN Nm) Nn) ⟩
  pred₁ (succ₁ m ∸ n)
    ≡⟨ sym (beta pred₁ (succ₁ m ∸ n)) ⟩
  lam pred₁ · (succ₁ m ∸ n)
    ≡⟨ refl ⟩
  (λ x → lam (λ y → pred₁ y)) n · (succ₁ m ∸ n)
    ≡⟨ ·-leftCong (sym (beta (λ x → lam (λ y → pred₁ y)) n)) ⟩
  (lam (λ x → lam (λ y → pred₁ y))) · n · (succ₁ m ∸ n)
    ≡⟨ sym (rec-S n (succ₁ m) (lam (λ x → lam (λ y → pred₁ y)))) ⟩
  rec (succ₁ n) (succ₁ m) (lam (λ x → lam (λ y → pred₁ y)))
    ≡⟨ refl ⟩
  succ₁ m ∸ succ₁ n ∎

*-0x : ∀ n → zero * n ≡ zero
*-0x n = rec zero zero (lam (λ _ → lam (λ y → n + y))) ≡⟨ rec-0 zero ⟩
         zero                                          ∎

*-Sx : ∀ m n → succ₁ m * n ≡ n + m * n
*-Sx m n =
  rec (succ₁ m) zero (lam (λ _ → lam (λ y → n + y)))
    ≡⟨ rec-S m zero (lam (λ _ → lam (λ y → n + y))) ⟩
  (lam (λ _ → lam (λ y → n + y))) · m · (m * n)
    ≡⟨ ·-leftCong (beta (λ _ → lam (λ y → n + y)) m) ⟩
  (λ _ → lam (λ y → n + y)) m · (m * n)
    ≡⟨ refl ⟩
  lam (λ y → n + y) · (m * n)
    ≡⟨ beta (λ y → n + y) (m * n) ⟩
  (λ y → n + y) (m * n)
    ≡⟨ refl ⟩
  n + (m * n) ∎

+-N : ∀ {m n} → N m → N n → N (m + n)
+-N {n = n} zN          Nn = subst N (sym (+-0x n)) Nn
+-N {n = n} (sN {m} Nm) Nn = subst N (sym (+-Sx m n)) (sN (+-N Nm Nn))

∸-N : ∀ {m n} → N m → N n → N (m ∸ n)
∸-N {m} Nm       zN     = subst N (sym (∸-x0 m)) Nm
∸-N     zN      (sN Nn) = subst N (sym (∸-0S Nn)) zN
∸-N     (sN Nm) (sN Nn) = subst N (sym (∸-SS Nm Nn)) (∸-N Nm Nn)

+-leftIdentity : ∀ n → zero + n ≡ n
+-leftIdentity = +-0x

+-rightIdentity : ∀ {n} → N n → n + zero ≡ n
+-rightIdentity zN          = +-leftIdentity zero
+-rightIdentity (sN {n} Nn) =
  trans (+-Sx n zero)
        (subst (λ t → succ₁ (n + zero) ≡ succ₁ t) (+-rightIdentity Nn) refl)

+-assoc : ∀ {m} → N m →  ∀ n o → m + n + o ≡ m + (n + o)
+-assoc zN n o =
  zero + n + o   ≡⟨ subst (λ t → zero + n + o ≡ t + o) (+-leftIdentity n) refl ⟩
  n + o          ≡⟨ sym (+-leftIdentity (n + o)) ⟩
  zero + (n + o) ∎

+-assoc (sN {m} Nm) n o =
  succ₁ m + n + o
    ≡⟨ subst (λ t → succ₁ m + n + o ≡ t + o) (+-Sx m n) refl ⟩
  succ₁ (m + n) + o
    ≡⟨ +-Sx (m + n) o ⟩
  succ₁ (m + n + o)
    ≡⟨ subst (λ t → succ₁ (m + n + o) ≡ succ₁ t) (+-assoc Nm n o) refl ⟩
  succ₁ (m + (n + o))
    ≡⟨ sym (+-Sx m (n + o)) ⟩
  succ₁ m + (n + o) ∎

x+Sy≡S[x+y] : ∀ {m} → N m → ∀ n → m + succ₁ n ≡ succ₁ (m + n)
x+Sy≡S[x+y] zN n =
  zero + succ₁ n ≡⟨ +-0x (succ₁ n) ⟩
  succ₁ n ≡⟨ subst (λ t → succ₁ n ≡ succ₁ t) (sym (+-leftIdentity n)) refl ⟩
  succ₁ (zero + n) ∎

x+Sy≡S[x+y] (sN {m} Nm) n =
  succ₁ m + succ₁ n
    ≡⟨ +-Sx m (succ₁ n) ⟩
  succ₁ (m + succ₁ n)
    ≡⟨ subst (λ t → succ₁ (m + succ₁ n) ≡ succ₁ t) (x+Sy≡S[x+y] Nm n) refl ⟩
  succ₁ (succ₁ (m + n))
    ≡⟨ subst (λ t → succ₁ (succ₁ (m + n)) ≡ succ₁ t) (sym (+-Sx m n)) refl ⟩
  succ₁ (succ₁ m + n) ∎

[x+y]∸[x+z]≡y∸z : ∀ {m n o} → N m → N n → N o → (m + n) ∸ (m + o) ≡ n ∸ o
[x+y]∸[x+z]≡y∸z {n = n} {o} zN _ _ =
  (zero + n) ∸ (zero + o)
    ≡⟨ subst (λ t → (zero + n) ∸ (zero + o) ≡ t ∸ (zero + o)) (+-0x n) refl ⟩
    n ∸ (zero + o)
      ≡⟨ subst (λ t → n ∸ (zero + o) ≡ n ∸ t) (+-0x o) refl ⟩
    n ∸ o ∎

[x+y]∸[x+z]≡y∸z {n = n} {o} (sN {m} Nm) Nn No =
  (succ₁ m + n) ∸ (succ₁ m + o)
    ≡⟨ subst (λ t → succ₁ m + n ∸ (succ₁ m + o) ≡ t ∸ (succ₁ m + o))
             (+-Sx m n)
             refl
    ⟩
  succ₁ (m + n) ∸ (succ₁ m + o)
    ≡⟨ subst (λ t → succ₁ (m + n) ∸ (succ₁ m + o) ≡ succ₁ (m + n) ∸ t)
             (+-Sx m o)
             refl
    ⟩
  succ₁ (m + n) ∸ succ₁ (m + o)
    ≡⟨ ∸-SS (+-N Nm Nn) (+-N Nm No) ⟩
  (m + n) ∸ (m + o)
    ≡⟨ [x+y]∸[x+z]≡y∸z Nm Nn No ⟩
  n ∸ o ∎

+-comm : ∀ {m n} → N m → N n → m + n ≡ n + m
+-comm {n = n} zN Nn =
  zero + n ≡⟨ +-leftIdentity n ⟩
  n        ≡⟨ sym (+-rightIdentity Nn) ⟩
  n + zero ∎

+-comm {n = n} (sN {m} Nm) Nn =
  succ₁ m + n   ≡⟨ +-Sx m n ⟩
  succ₁ (m + n) ≡⟨ succCong (+-comm Nm Nn) ⟩
  succ₁ (n + m) ≡⟨ sym (x+Sy≡S[x+y] Nn m) ⟩
  n + succ₁ m   ∎

*-leftZero : ∀ n → zero * n ≡ zero
*-leftZero = *-0x

*-N : ∀ {m n} → N m → N n → N (m * n)
*-N {n = n} zN          _  = subst N (sym (*-0x n)) zN
*-N {n = n} (sN {m} Nm) Nn = subst N (sym (*-Sx m n)) (+-N Nn (*-N Nm Nn))

*-rightZero : ∀ {n} → N n → n * zero ≡ zero
*-rightZero zN          = *-leftZero zero
*-rightZero (sN {n} Nn) =
  trans (*-Sx n zero)
        (trans (+-leftIdentity (n * zero)) (*-rightZero Nn))

*-leftIdentity : ∀ {n} → N n → succ₁ zero * n ≡ n
*-leftIdentity {n} Nn =
  succ₁ zero * n ≡⟨ *-Sx zero n ⟩
  n + zero * n   ≡⟨ subst (λ t → n + zero * n ≡ n + t) (*-leftZero n) refl ⟩
  n + zero       ≡⟨ +-rightIdentity Nn ⟩
  n              ∎

x*Sy≡x+xy : ∀ {m n} → N m → N n → m * succ₁ n ≡ m + m * n
x*Sy≡x+xy {n = n} zN _ = sym
  ( zero + zero * n
      ≡⟨ subst (λ t → zero + zero * n ≡ zero + t) (*-leftZero n) refl ⟩
    zero + zero
      ≡⟨ +-leftIdentity zero ⟩
    zero
      ≡⟨ sym (*-leftZero (succ₁ n)) ⟩
    zero * succ₁ n ∎
  )

x*Sy≡x+xy {n = n} (sN {m} Nm) Nn =
  succ₁ m * succ₁ n
    ≡⟨ *-Sx m (succ₁ n) ⟩
  succ₁ n + m * succ₁ n
    ≡⟨ subst (λ t → succ₁ n + m * succ₁ n ≡ succ₁ n + t)
             (x*Sy≡x+xy Nm Nn)
             refl
    ⟩
  succ₁ n + (m + m * n)
    ≡⟨ +-Sx n (m + m * n) ⟩
  succ₁ (n + (m + m * n))
    ≡⟨ subst (λ t → succ₁ (n + (m + m * n)) ≡ succ₁ t)
             (sym (+-assoc Nn m (m * n)))
             refl
    ⟩
  succ₁ (n + m + m * n)
    ≡⟨ subst (λ t → succ₁ (n + m + m * n) ≡ succ₁ (t + m * n))
             (+-comm Nn Nm)
             refl
    ⟩
  succ₁ (m + n + m * n)
    ≡⟨ subst (λ t → succ₁ (m + n + m * n) ≡ succ₁ t)
             (+-assoc Nm n (m * n))
             refl
    ⟩
  succ₁ (m + (n + m * n))
    ≡⟨ sym (+-Sx m (n + m * n)) ⟩
  succ₁ m + (n + m * n)
    ≡⟨ subst (λ t → succ₁ m + (n + m * n) ≡ succ₁ m + t)
             (sym (*-Sx m n))
             refl
    ⟩
  succ₁ m + succ₁ m * n ∎

*-comm : ∀ {m n} → N m → N n → m * n ≡ n * m
*-comm {n = n} zN Nn          = trans (*-leftZero n) (sym (*-rightZero Nn))
*-comm {n = n} (sN {m} Nm) Nn =
  succ₁ m * n  ≡⟨ *-Sx m n ⟩
  n + m * n    ≡⟨ subst (λ t → n + m * n ≡ n + t) (*-comm Nm Nn) refl ⟩
  n + n * m    ≡⟨ sym (x*Sy≡x+xy Nn Nm) ⟩
  n * succ₁ m  ∎

*∸-leftDistributive : ∀ {m n o} → N m → N n → N o → (m ∸ n) * o ≡ m * o ∸ n * o
*∸-leftDistributive {m} {o = o} _ zN _ =
  (m ∸ zero) * o   ≡⟨ subst (λ t → (m ∸ zero) * o ≡ t * o) (∸-x0 m) refl ⟩
  m * o            ≡⟨ sym (∸-x0 (m * o)) ⟩
  m * o ∸ zero     ≡⟨ subst (λ t → m * o ∸ zero ≡ m * o ∸ t) (sym (*-0x o)) refl ⟩
  m * o ∸ zero * o ∎

*∸-leftDistributive {o = o} zN (sN {n} Nn) No =
  (zero ∸ succ₁ n) * o
    ≡⟨ subst (λ t → (zero ∸ succ₁ n) * o ≡ t * o) (∸-0S Nn) refl ⟩
  zero * o
    ≡⟨ *-0x o ⟩
  zero
    ≡⟨ sym (∸-0x (*-N (sN Nn) No)) ⟩
  zero ∸ succ₁ n * o
    ≡⟨ subst (λ t → zero ∸ succ₁ n * o ≡ t ∸ succ₁ n * o)
             (sym (*-0x o))
             refl
    ⟩
  zero * o ∸ succ₁ n * o ∎

*∸-leftDistributive (sN {m} Nm) (sN {n} Nn) zN =
  (succ₁ m ∸ succ₁ n) * zero
    ≡⟨ *-comm (∸-N (sN Nm) (sN Nn)) zN ⟩
  zero * (succ₁ m ∸ succ₁ n)
    ≡⟨ *-0x (succ₁ m ∸ succ₁ n) ⟩
  zero
    ≡⟨ sym (∸-0x (*-N (sN Nn) zN)) ⟩
  zero ∸ succ₁ n * zero
    ≡⟨ subst (λ t → zero ∸ succ₁ n * zero ≡ t ∸ succ₁ n * zero)
             (sym (*-0x (succ₁ m)))
             refl
    ⟩
  zero * succ₁ m ∸ succ₁ n * zero
    ≡⟨ subst (λ t → zero * succ₁ m ∸ succ₁ n * zero ≡ t ∸ succ₁ n * zero)
             (*-comm zN (sN Nm))
             refl
    ⟩
  succ₁ m * zero ∸ succ₁ n * zero ∎

*∸-leftDistributive (sN {m} Nm) (sN {n} Nn) (sN {o} No) =
  (succ₁ m ∸ succ₁ n) * succ₁ o
    ≡⟨ subst (λ t → (succ₁ m ∸ succ₁ n) * succ₁ o ≡ t * succ₁ o)
             (∸-SS Nm Nn)
             refl
    ⟩
  (m ∸ n) * succ₁ o
    ≡⟨ *∸-leftDistributive Nm Nn (sN No) ⟩
  m * succ₁ o ∸ n * succ₁ o
    ≡⟨ sym ([x+y]∸[x+z]≡y∸z (sN No) (*-N Nm (sN No)) (*-N Nn (sN No))) ⟩
  (succ₁ o + m * succ₁ o) ∸ (succ₁ o + n * succ₁ o)
    ≡⟨ subst (λ t → (succ₁ o + m * succ₁ o) ∸ (succ₁ o + n * succ₁ o) ≡
                    t ∸ (succ₁ o + n * succ₁ o))
             (sym (*-Sx m (succ₁ o)))
             refl
    ⟩
  (succ₁ m * succ₁ o) ∸ (succ₁ o + n * succ₁ o)
    ≡⟨ subst (λ t → (succ₁ m * succ₁ o) ∸ (succ₁ o + n * succ₁ o) ≡
                    (succ₁ m * succ₁ o) ∸ t)
             (sym (*-Sx n (succ₁ o)))
             refl
    ⟩
  (succ₁ m * succ₁ o) ∸ (succ₁ n * succ₁ o) ∎

*+-leftDistributive : ∀ {m n o} → N m → N n → N o → (m + n) * o ≡ m * o + n * o
*+-leftDistributive {m} {n} Nm Nn zN =
  (m + n) * zero       ≡⟨ *-comm (+-N Nm Nn) zN ⟩
  zero * (m + n)       ≡⟨ *-0x (m + n) ⟩
  zero                 ≡⟨ sym (*-0x m) ⟩
  zero * m             ≡⟨ *-comm zN Nm ⟩
  m * zero             ≡⟨ sym (+-rightIdentity (*-N Nm zN)) ⟩
  m * zero + zero      ≡⟨ subst (λ t → m * zero + zero ≡ m * zero + t)
                                (trans (sym (*-0x n)) (*-comm zN Nn))
                                  refl
                       ⟩
  m * zero + n * zero  ∎

*+-leftDistributive {n = n} zN Nn (sN {o} No) =
  (zero + n) * succ₁ o
    ≡⟨ subst (λ t → (zero + n) * succ₁ o ≡ t * succ₁ o)
             (+-leftIdentity n)
             refl
    ⟩
  n * succ₁ o
    ≡⟨ sym (+-leftIdentity (n * succ₁ o)) ⟩
  zero + n * succ₁ o
    ≡⟨ subst (λ t → zero + n * succ₁ o ≡ t +  n * succ₁ o)
             (sym (*-0x (succ₁ o)))
             refl
    ⟩
  zero * succ₁ o + n * succ₁ o ∎

*+-leftDistributive (sN {m} Nm) zN (sN {o} No) =
  (succ₁ m + zero) * succ₁ o
    ≡⟨ subst (λ t → (succ₁ m + zero) * succ₁ o ≡ t * succ₁ o)
             (+-rightIdentity (sN Nm))
             refl
    ⟩
  succ₁ m * succ₁ o
    ≡⟨ sym (+-rightIdentity (*-N (sN Nm) (sN No))) ⟩
  succ₁ m * succ₁ o + zero
    ≡⟨ subst (λ t → succ₁ m * succ₁ o + zero ≡ succ₁ m * succ₁ o + t)
             (sym (*-leftZero (succ₁ o)))
             refl
    ⟩
    succ₁ m * succ₁ o + zero * succ₁ o ∎

*+-leftDistributive (sN {m} Nm) (sN {n} Nn) (sN {o} No) =
  (succ₁ m + succ₁ n) * succ₁ o
    ≡⟨ subst (λ t → (succ₁ m + succ₁ n) * succ₁ o ≡ t * succ₁ o)
             (+-Sx m (succ₁ n))
             refl
    ⟩
  succ₁ (m + succ₁ n) * succ₁ o
    ≡⟨ *-Sx (m + succ₁ n) (succ₁ o) ⟩
  succ₁ o + (m + succ₁ n) * succ₁ o
    ≡⟨ subst (λ t → succ₁ o + (m + succ₁ n) * succ₁ o ≡ succ₁ o + t)
             (*+-leftDistributive Nm (sN Nn) (sN No))
             refl
    ⟩
  succ₁ o + (m * succ₁ o + succ₁ n * succ₁ o)
    ≡⟨ sym (+-assoc (sN No) (m * succ₁ o) (succ₁ n * succ₁ o)) ⟩
  succ₁ o + m * succ₁ o + succ₁ n * succ₁ o
    ≡⟨ subst (λ t → succ₁ o + m * succ₁ o + succ₁ n * succ₁ o ≡
                    t + succ₁ n * succ₁ o)
             (sym (*-Sx m (succ₁ o)))
             refl
    ⟩
  succ₁ m * succ₁ o + succ₁ n * succ₁ o ∎

------------------------------------------------------------------------------
-- Arithmetic properties
------------------------------------------------------------------------------

{-# OPTIONS --no-universe-polymorphism #-}
{-# OPTIONS --without-K #-}

module LTC-PCF.Data.Nat.PropertiesI where

open import Common.FOL.Relation.Binary.EqReasoning

open import LTC-PCF.Base
open import LTC-PCF.Base.Properties
open import LTC-PCF.Data.Nat
open import LTC-PCF.Data.Nat.Rec
open import LTC-PCF.Data.Nat.Rec.EquationsI

------------------------------------------------------------------------------
-- Congruence properties

+-leftCong : ∀ {m n o} → m ≡ n → m + o ≡ n + o
+-leftCong refl = refl

+-rightCong : ∀ {m n o} → n ≡ o → m + n ≡ m + o
+-rightCong refl = refl

∸-leftCong : ∀ {m n o} → m ≡ n → m ∸ o ≡ n ∸ o
∸-leftCong refl = refl

∸-rightCong : ∀ {m n o} → n ≡ o → m ∸ n ≡ m ∸ o
∸-rightCong refl = refl

*-leftCong : ∀ {m n o} → m ≡ n → m * o ≡ n * o
*-leftCong refl = refl

*-rightCong : ∀ {m n o} → n ≡ o → m * n ≡ m * o
*-rightCong refl = refl

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

+-0x : ∀ n → zero + n ≡ n
+-0x n = rec zero n _ ≡⟨ rec-0 n ⟩
         n            ∎

+-Sx : ∀ m n → succ₁ m + n ≡ succ₁ (m + n)
+-Sx m n =
  rec (succ₁ m) n (lam (λ x → lam (λ y → succ₁ y)))
    ≡⟨ rec-S m n (lam (λ x → lam (λ y → succ₁ y))) ⟩
  (lam (λ x → lam (λ y → succ₁ y))) · m · (m + n)
    ≡⟨ ·-leftCong (beta (λ x → lam (λ y → succ₁ y)) m) ⟩
  (λ x → lam (λ y → succ₁ y)) m · (m + n)
    ≡⟨ refl ⟩
  lam succ₁ · (m + n)
    ≡⟨ beta succ₁ (m + n) ⟩
  succ₁ (m + n) ∎

∸-x0 : ∀ n → n ∸ zero ≡ n
∸-x0 n = rec zero n _ ≡⟨ rec-0 n ⟩
         n            ∎

∸-0S : ∀ {n} → N n → zero ∸ succ₁ n ≡ zero
∸-0S zN =
  rec (succ₁ zero) zero (lam (λ x → lam (λ y → pred₁ y)))
    ≡⟨ rec-S zero zero (lam (λ x → lam (λ y → pred₁ y))) ⟩
  lam (λ x → lam (λ y → pred₁ y)) · zero · (zero ∸ zero)
    ≡⟨ ·-leftCong (beta (λ x → lam (λ y → pred₁ y)) zero) ⟩
  (λ x → lam (λ y → pred₁ y)) zero · (zero ∸ zero)
    ≡⟨ refl ⟩
  lam pred₁ · (zero ∸ zero)
    ≡⟨ beta pred₁ (zero ∸ zero) ⟩
  pred₁ (zero ∸ zero)
    ≡⟨ cong pred₁ (∸-x0 zero) ⟩
  pred₁ zero
    ≡⟨ pred-0 ⟩
  zero ∎

∸-0S (sN {n} Nn) =
  rec (succ₁ (succ₁ n)) zero (lam (λ x → lam (λ y → pred₁ y)))
    ≡⟨ rec-S (succ₁ n) zero (lam (λ x → lam (λ y → pred₁ y))) ⟩
  lam (λ x → lam (λ y → pred₁ y)) · (succ₁ n) · (zero ∸ (succ₁ n))
    ≡⟨ ·-leftCong (beta (λ x → lam (λ y → pred₁ y)) (succ₁ n)) ⟩
  (λ x → lam (λ y → pred₁ y))  (succ₁ n) · (zero ∸ (succ₁ n))
    ≡⟨ refl ⟩
  lam pred₁ · (zero ∸ (succ₁ n))
    ≡⟨ beta pred₁ (zero ∸ (succ₁ n)) ⟩
  pred₁ (zero ∸ (succ₁ n))
    ≡⟨ cong pred₁ (∸-0S Nn) ⟩
  pred₁ zero
    ≡⟨ pred-0 ⟩
  zero ∎

∸-0x : ∀ {n} → N n → zero ∸ n ≡ zero
∸-0x zN      = ∸-x0 zero
∸-0x (sN Nn) = ∸-0S Nn

∸-SS : ∀ {m n} → N m → N n → succ₁ m ∸ succ₁ n ≡ m ∸ n
∸-SS {m} _ zN =
  rec (succ₁ zero) (succ₁ m) (lam (λ x → lam (λ y → pred₁ y)))
    ≡⟨ rec-S zero (succ₁ m) (lam (λ x → lam (λ y → pred₁ y))) ⟩
  lam (λ x → lam (λ y → pred₁ y))  · zero · (succ₁ m ∸ zero)
    ≡⟨ ·-leftCong (beta (λ x → lam (λ y → pred₁ y)) zero) ⟩
  (λ x → lam (λ y → pred₁ y)) zero · (succ₁ m ∸ zero)
    ≡⟨ refl ⟩
  lam pred₁ · (succ₁ m ∸ zero)
    ≡⟨ beta pred₁ (succ₁ m ∸ zero) ⟩
  pred₁ (succ₁ m ∸ zero)
    ≡⟨ cong pred₁ (∸-x0 (succ₁ m)) ⟩
  pred₁ (succ₁ m)
    ≡⟨ pred-S m ⟩
  m
    ≡⟨ sym (∸-x0 m) ⟩
  m ∸ zero ∎

∸-SS zN (sN {n} Nn) =
  rec (succ₁ (succ₁ n)) (succ₁ zero) (lam (λ x → lam (λ y → pred₁ y)))
    ≡⟨ rec-S (succ₁ n) (succ₁ zero) (lam (λ x → lam (λ y → pred₁ y)))  ⟩
  lam (λ x → lam (λ y → pred₁ y)) · (succ₁ n) · (succ₁ zero ∸ succ₁ n)
    ≡⟨ ·-leftCong (beta (λ x → lam (λ y → pred₁ y)) (succ₁ n)) ⟩
  (λ x → lam (λ y → pred₁ y)) (succ₁ n) · (succ₁ zero ∸ succ₁ n)
    ≡⟨ refl ⟩
  lam pred₁ · (succ₁ zero ∸ succ₁ n)
    ≡⟨ beta pred₁ (succ₁ zero ∸ succ₁ n) ⟩
  pred₁ (succ₁ zero ∸ succ₁ n)
    ≡⟨ cong pred₁ (∸-SS zN Nn) ⟩
  pred₁ (zero ∸ n)
    ≡⟨ cong pred₁ (∸-0x Nn) ⟩
  pred₁ zero
    ≡⟨ pred-0 ⟩
  zero
    ≡⟨ sym (∸-0S Nn) ⟩
  zero ∸ succ₁ n ∎

∸-SS (sN {m} Nm) (sN {n} Nn) =
  rec (succ₁ (succ₁ n)) (succ₁ (succ₁ m)) (lam (λ x → lam (λ y → pred₁ y)))
    ≡⟨ rec-S (succ₁ n) (succ₁ (succ₁ m)) (lam (λ x → lam (λ y → pred₁ y))) ⟩
  lam (λ x → lam (λ y → pred₁ y)) · (succ₁ n) · (succ₁ (succ₁ m) ∸ succ₁ n)
    ≡⟨ ·-leftCong (beta (λ x → lam (λ y → pred₁ y)) (succ₁ n)) ⟩
  (λ x → lam (λ y → pred₁ y)) (succ₁ n) · (succ₁ (succ₁ m) ∸ succ₁ n)
    ≡⟨ refl ⟩
  lam pred₁ · (succ₁ (succ₁ m) ∸ succ₁ n)
    ≡⟨ beta pred₁ (succ₁ (succ₁ m) ∸ succ₁ n) ⟩
  pred₁ (succ₁ (succ₁ m) ∸ succ₁ n)
    ≡⟨ cong pred₁ (∸-SS (sN Nm) Nn) ⟩
  pred₁ (succ₁ m ∸ n)
    ≡⟨ sym (beta pred₁ (succ₁ m ∸ n)) ⟩
  lam pred₁ · (succ₁ m ∸ n)
    ≡⟨ refl ⟩
  (λ x → lam (λ y → pred₁ y)) n · (succ₁ m ∸ n)
    ≡⟨ ·-leftCong (sym (beta (λ x → lam (λ y → pred₁ y)) n)) ⟩
  (lam (λ x → lam (λ y → pred₁ y))) · n · (succ₁ m ∸ n)
    ≡⟨ sym (rec-S n (succ₁ m) (lam (λ x → lam (λ y → pred₁ y)))) ⟩
  rec (succ₁ n) (succ₁ m) (lam (λ x → lam (λ y → pred₁ y)))
    ≡⟨ refl ⟩
  succ₁ m ∸ succ₁ n ∎

*-0x : ∀ n → zero * n ≡ zero
*-0x n = rec zero zero (lam (λ _ → lam (λ y → n + y))) ≡⟨ rec-0 zero ⟩
         zero                                          ∎

*-Sx : ∀ m n → succ₁ m * n ≡ n + m * n
*-Sx m n =
  rec (succ₁ m) zero (lam (λ _ → lam (λ y → n + y)))
    ≡⟨ rec-S m zero (lam (λ _ → lam (λ y → n + y))) ⟩
  (lam (λ _ → lam (λ y → n + y))) · m · (m * n)
    ≡⟨ ·-leftCong (beta (λ _ → lam (λ y → n + y)) m) ⟩
  (λ _ → lam (λ y → n + y)) m · (m * n)
    ≡⟨ refl ⟩
  lam (λ y → n + y) · (m * n)
    ≡⟨ beta (λ y → n + y) (m * n) ⟩
  (λ y → n + y) (m * n)
    ≡⟨ refl ⟩
  n + (m * n) ∎

+-N : ∀ {m n} → N m → N n → N (m + n)
+-N {n = n} zN          Nn = subst N (sym (+-0x n)) Nn
+-N {n = n} (sN {m} Nm) Nn = subst N (sym (+-Sx m n)) (sN (+-N Nm Nn))

∸-N : ∀ {m n} → N m → N n → N (m ∸ n)
∸-N {m} Nm       zN     = subst N (sym (∸-x0 m)) Nm
∸-N     zN      (sN Nn) = subst N (sym (∸-0S Nn)) zN
∸-N     (sN Nm) (sN Nn) = subst N (sym (∸-SS Nm Nn)) (∸-N Nm Nn)

+-leftIdentity : ∀ n → zero + n ≡ n
+-leftIdentity = +-0x

+-rightIdentity : ∀ {n} → N n → n + zero ≡ n
+-rightIdentity zN          = +-leftIdentity zero
+-rightIdentity (sN {n} Nn) =
  trans (+-Sx n zero)
        (subst (λ t → succ₁ (n + zero) ≡ succ₁ t) (+-rightIdentity Nn) refl)

+-assoc : ∀ {m} → N m →  ∀ n o → m + n + o ≡ m + (n + o)
+-assoc zN n o =
  zero + n + o   ≡⟨ subst (λ t → zero + n + o ≡ t + o) (+-leftIdentity n) refl ⟩
  n + o          ≡⟨ sym (+-leftIdentity (n + o)) ⟩
  zero + (n + o) ∎

+-assoc (sN {m} Nm) n o =
  succ₁ m + n + o
    ≡⟨ subst (λ t → succ₁ m + n + o ≡ t + o) (+-Sx m n) refl ⟩
  succ₁ (m + n) + o
    ≡⟨ +-Sx (m + n) o ⟩
  succ₁ (m + n + o)
    ≡⟨ subst (λ t → succ₁ (m + n + o) ≡ succ₁ t) (+-assoc Nm n o) refl ⟩
  succ₁ (m + (n + o))
    ≡⟨ sym (+-Sx m (n + o)) ⟩
  succ₁ m + (n + o) ∎

x+Sy≡S[x+y] : ∀ {m} → N m → ∀ n → m + succ₁ n ≡ succ₁ (m + n)
x+Sy≡S[x+y] zN n =
  zero + succ₁ n ≡⟨ +-0x (succ₁ n) ⟩
  succ₁ n ≡⟨ subst (λ t → succ₁ n ≡ succ₁ t) (sym (+-leftIdentity n)) refl ⟩
  succ₁ (zero + n) ∎

x+Sy≡S[x+y] (sN {m} Nm) n =
  succ₁ m + succ₁ n
    ≡⟨ +-Sx m (succ₁ n) ⟩
  succ₁ (m + succ₁ n)
    ≡⟨ subst (λ t → succ₁ (m + succ₁ n) ≡ succ₁ t) (x+Sy≡S[x+y] Nm n) refl ⟩
  succ₁ (succ₁ (m + n))
    ≡⟨ subst (λ t → succ₁ (succ₁ (m + n)) ≡ succ₁ t) (sym (+-Sx m n)) refl ⟩
  succ₁ (succ₁ m + n) ∎

[x+y]∸[x+z]≡y∸z : ∀ {m n o} → N m → N n → N o → (m + n) ∸ (m + o) ≡ n ∸ o
[x+y]∸[x+z]≡y∸z {n = n} {o} zN _ _ =
  (zero + n) ∸ (zero + o)
    ≡⟨ subst (λ t → (zero + n) ∸ (zero + o) ≡ t ∸ (zero + o)) (+-0x n) refl ⟩
    n ∸ (zero + o)
      ≡⟨ subst (λ t → n ∸ (zero + o) ≡ n ∸ t) (+-0x o) refl ⟩
    n ∸ o ∎

[x+y]∸[x+z]≡y∸z {n = n} {o} (sN {m} Nm) Nn No =
  (succ₁ m + n) ∸ (succ₁ m + o)
    ≡⟨ subst (λ t → succ₁ m + n ∸ (succ₁ m + o) ≡ t ∸ (succ₁ m + o))
             (+-Sx m n)
             refl
    ⟩
  succ₁ (m + n) ∸ (succ₁ m + o)
    ≡⟨ subst (λ t → succ₁ (m + n) ∸ (succ₁ m + o) ≡ succ₁ (m + n) ∸ t)
             (+-Sx m o)
             refl
    ⟩
  succ₁ (m + n) ∸ succ₁ (m + o)
    ≡⟨ ∸-SS (+-N Nm Nn) (+-N Nm No) ⟩
  (m + n) ∸ (m + o)
    ≡⟨ [x+y]∸[x+z]≡y∸z Nm Nn No ⟩
  n ∸ o ∎

+-comm : ∀ {m n} → N m → N n → m + n ≡ n + m
+-comm {n = n} zN Nn =
  zero + n ≡⟨ +-leftIdentity n ⟩
  n        ≡⟨ sym (+-rightIdentity Nn) ⟩
  n + zero ∎

+-comm {n = n} (sN {m} Nm) Nn =
  succ₁ m + n   ≡⟨ +-Sx m n ⟩
  succ₁ (m + n) ≡⟨ cong succ₁ (+-comm Nm Nn) ⟩
  succ₁ (n + m) ≡⟨ sym (x+Sy≡S[x+y] Nn m) ⟩
  n + succ₁ m   ∎

*-leftZero : ∀ n → zero * n ≡ zero
*-leftZero = *-0x

*-N : ∀ {m n} → N m → N n → N (m * n)
*-N {n = n} zN          _  = subst N (sym (*-0x n)) zN
*-N {n = n} (sN {m} Nm) Nn = subst N (sym (*-Sx m n)) (+-N Nn (*-N Nm Nn))

*-rightZero : ∀ {n} → N n → n * zero ≡ zero
*-rightZero zN          = *-leftZero zero
*-rightZero (sN {n} Nn) =
  trans (*-Sx n zero)
        (trans (+-leftIdentity (n * zero)) (*-rightZero Nn))

*-leftIdentity : ∀ {n} → N n → succ₁ zero * n ≡ n
*-leftIdentity {n} Nn =
  succ₁ zero * n ≡⟨ *-Sx zero n ⟩
  n + zero * n   ≡⟨ subst (λ t → n + zero * n ≡ n + t) (*-leftZero n) refl ⟩
  n + zero       ≡⟨ +-rightIdentity Nn ⟩
  n              ∎

x*Sy≡x+xy : ∀ {m n} → N m → N n → m * succ₁ n ≡ m + m * n
x*Sy≡x+xy {n = n} zN _ = sym
  ( zero + zero * n
      ≡⟨ subst (λ t → zero + zero * n ≡ zero + t) (*-leftZero n) refl ⟩
    zero + zero
      ≡⟨ +-leftIdentity zero ⟩
    zero
      ≡⟨ sym (*-leftZero (succ₁ n)) ⟩
    zero * succ₁ n ∎
  )

x*Sy≡x+xy {n = n} (sN {m} Nm) Nn =
  succ₁ m * succ₁ n
    ≡⟨ *-Sx m (succ₁ n) ⟩
  succ₁ n + m * succ₁ n
    ≡⟨ subst (λ t → succ₁ n + m * succ₁ n ≡ succ₁ n + t)
             (x*Sy≡x+xy Nm Nn)
             refl
    ⟩
  succ₁ n + (m + m * n)
    ≡⟨ +-Sx n (m + m * n) ⟩
  succ₁ (n + (m + m * n))
    ≡⟨ subst (λ t → succ₁ (n + (m + m * n)) ≡ succ₁ t)
             (sym (+-assoc Nn m (m * n)))
             refl
    ⟩
  succ₁ (n + m + m * n)
    ≡⟨ subst (λ t → succ₁ (n + m + m * n) ≡ succ₁ (t + m * n))
             (+-comm Nn Nm)
             refl
    ⟩
  succ₁ (m + n + m * n)
    ≡⟨ subst (λ t → succ₁ (m + n + m * n) ≡ succ₁ t)
             (+-assoc Nm n (m * n))
             refl
    ⟩
  succ₁ (m + (n + m * n))
    ≡⟨ sym (+-Sx m (n + m * n)) ⟩
  succ₁ m + (n + m * n)
    ≡⟨ subst (λ t → succ₁ m + (n + m * n) ≡ succ₁ m + t)
             (sym (*-Sx m n))
             refl
    ⟩
  succ₁ m + succ₁ m * n ∎

*-comm : ∀ {m n} → N m → N n → m * n ≡ n * m
*-comm {n = n} zN Nn          = trans (*-leftZero n) (sym (*-rightZero Nn))
*-comm {n = n} (sN {m} Nm) Nn =
  succ₁ m * n  ≡⟨ *-Sx m n ⟩
  n + m * n    ≡⟨ subst (λ t → n + m * n ≡ n + t) (*-comm Nm Nn) refl ⟩
  n + n * m    ≡⟨ sym (x*Sy≡x+xy Nn Nm) ⟩
  n * succ₁ m  ∎

*∸-leftDistributive : ∀ {m n o} → N m → N n → N o → (m ∸ n) * o ≡ m * o ∸ n * o
*∸-leftDistributive {m} {o = o} _ zN _ =
  (m ∸ zero) * o   ≡⟨ subst (λ t → (m ∸ zero) * o ≡ t * o) (∸-x0 m) refl ⟩
  m * o            ≡⟨ sym (∸-x0 (m * o)) ⟩
  m * o ∸ zero     ≡⟨ subst (λ t → m * o ∸ zero ≡ m * o ∸ t) (sym (*-0x o)) refl ⟩
  m * o ∸ zero * o ∎

*∸-leftDistributive {o = o} zN (sN {n} Nn) No =
  (zero ∸ succ₁ n) * o
    ≡⟨ subst (λ t → (zero ∸ succ₁ n) * o ≡ t * o) (∸-0S Nn) refl ⟩
  zero * o
    ≡⟨ *-0x o ⟩
  zero
    ≡⟨ sym (∸-0x (*-N (sN Nn) No)) ⟩
  zero ∸ succ₁ n * o
    ≡⟨ subst (λ t → zero ∸ succ₁ n * o ≡ t ∸ succ₁ n * o)
             (sym (*-0x o))
             refl
    ⟩
  zero * o ∸ succ₁ n * o ∎

*∸-leftDistributive (sN {m} Nm) (sN {n} Nn) zN =
  (succ₁ m ∸ succ₁ n) * zero
    ≡⟨ *-comm (∸-N (sN Nm) (sN Nn)) zN ⟩
  zero * (succ₁ m ∸ succ₁ n)
    ≡⟨ *-0x (succ₁ m ∸ succ₁ n) ⟩
  zero
    ≡⟨ sym (∸-0x (*-N (sN Nn) zN)) ⟩
  zero ∸ succ₁ n * zero
    ≡⟨ subst (λ t → zero ∸ succ₁ n * zero ≡ t ∸ succ₁ n * zero)
             (sym (*-0x (succ₁ m)))
             refl
    ⟩
  zero * succ₁ m ∸ succ₁ n * zero
    ≡⟨ subst (λ t → zero * succ₁ m ∸ succ₁ n * zero ≡ t ∸ succ₁ n * zero)
             (*-comm zN (sN Nm))
             refl
    ⟩
  succ₁ m * zero ∸ succ₁ n * zero ∎

*∸-leftDistributive (sN {m} Nm) (sN {n} Nn) (sN {o} No) =
  (succ₁ m ∸ succ₁ n) * succ₁ o
    ≡⟨ subst (λ t → (succ₁ m ∸ succ₁ n) * succ₁ o ≡ t * succ₁ o)
             (∸-SS Nm Nn)
             refl
    ⟩
  (m ∸ n) * succ₁ o
    ≡⟨ *∸-leftDistributive Nm Nn (sN No) ⟩
  m * succ₁ o ∸ n * succ₁ o
    ≡⟨ sym ([x+y]∸[x+z]≡y∸z (sN No) (*-N Nm (sN No)) (*-N Nn (sN No))) ⟩
  (succ₁ o + m * succ₁ o) ∸ (succ₁ o + n * succ₁ o)
    ≡⟨ subst (λ t → (succ₁ o + m * succ₁ o) ∸ (succ₁ o + n * succ₁ o) ≡
                    t ∸ (succ₁ o + n * succ₁ o))
             (sym (*-Sx m (succ₁ o)))
             refl
    ⟩
  (succ₁ m * succ₁ o) ∸ (succ₁ o + n * succ₁ o)
    ≡⟨ subst (λ t → (succ₁ m * succ₁ o) ∸ (succ₁ o + n * succ₁ o) ≡
                    (succ₁ m * succ₁ o) ∸ t)
             (sym (*-Sx n (succ₁ o)))
             refl
    ⟩
  (succ₁ m * succ₁ o) ∸ (succ₁ n * succ₁ o) ∎

*+-leftDistributive : ∀ {m n o} → N m → N n → N o → (m + n) * o ≡ m * o + n * o
*+-leftDistributive {m} {n} Nm Nn zN =
  (m + n) * zero       ≡⟨ *-comm (+-N Nm Nn) zN ⟩
  zero * (m + n)       ≡⟨ *-0x (m + n) ⟩
  zero                 ≡⟨ sym (*-0x m) ⟩
  zero * m             ≡⟨ *-comm zN Nm ⟩
  m * zero             ≡⟨ sym (+-rightIdentity (*-N Nm zN)) ⟩
  m * zero + zero      ≡⟨ subst (λ t → m * zero + zero ≡ m * zero + t)
                                (trans (sym (*-0x n)) (*-comm zN Nn))
                                  refl
                       ⟩
  m * zero + n * zero  ∎

*+-leftDistributive {n = n} zN Nn (sN {o} No) =
  (zero + n) * succ₁ o
    ≡⟨ subst (λ t → (zero + n) * succ₁ o ≡ t * succ₁ o)
             (+-leftIdentity n)
             refl
    ⟩
  n * succ₁ o
    ≡⟨ sym (+-leftIdentity (n * succ₁ o)) ⟩
  zero + n * succ₁ o
    ≡⟨ subst (λ t → zero + n * succ₁ o ≡ t +  n * succ₁ o)
             (sym (*-0x (succ₁ o)))
             refl
    ⟩
  zero * succ₁ o + n * succ₁ o ∎

*+-leftDistributive (sN {m} Nm) zN (sN {o} No) =
  (succ₁ m + zero) * succ₁ o
    ≡⟨ subst (λ t → (succ₁ m + zero) * succ₁ o ≡ t * succ₁ o)
             (+-rightIdentity (sN Nm))
             refl
    ⟩
  succ₁ m * succ₁ o
    ≡⟨ sym (+-rightIdentity (*-N (sN Nm) (sN No))) ⟩
  succ₁ m * succ₁ o + zero
    ≡⟨ subst (λ t → succ₁ m * succ₁ o + zero ≡ succ₁ m * succ₁ o + t)
             (sym (*-leftZero (succ₁ o)))
             refl
    ⟩
    succ₁ m * succ₁ o + zero * succ₁ o ∎

*+-leftDistributive (sN {m} Nm) (sN {n} Nn) (sN {o} No) =
  (succ₁ m + succ₁ n) * succ₁ o
    ≡⟨ subst (λ t → (succ₁ m + succ₁ n) * succ₁ o ≡ t * succ₁ o)
             (+-Sx m (succ₁ n))
             refl
    ⟩
  succ₁ (m + succ₁ n) * succ₁ o
    ≡⟨ *-Sx (m + succ₁ n) (succ₁ o) ⟩
  succ₁ o + (m + succ₁ n) * succ₁ o
    ≡⟨ subst (λ t → succ₁ o + (m + succ₁ n) * succ₁ o ≡ succ₁ o + t)
             (*+-leftDistributive Nm (sN Nn) (sN No))
             refl
    ⟩
  succ₁ o + (m * succ₁ o + succ₁ n * succ₁ o)
    ≡⟨ sym (+-assoc (sN No) (m * succ₁ o) (succ₁ n * succ₁ o)) ⟩
  succ₁ o + m * succ₁ o + succ₁ n * succ₁ o
    ≡⟨ subst (λ t → succ₁ o + m * succ₁ o + succ₁ n * succ₁ o ≡
                    t + succ₁ n * succ₁ o)
             (sym (*-Sx m (succ₁ o)))
             refl
    ⟩
  succ₁ m * succ₁ o + succ₁ n * succ₁ o ∎


updating constructor name

updating constructor name

open import Nat
open import Prelude
open import List
open import core
open import contexts
open import lemmas-consistency
open import canonical-forms

module progress where

  -- this is a little bit of syntactic sugar to avoid many layer nested Inl
  -- and Inrs that you would get from the more literal transcription of the
  -- consequent of progress as:
  --
  -- d val + d indet + d err[ Δ ] + Σ[ d' ∈ dhexp ] (Δ ⊢ d ↦ d')
  data ok : (d : dhexp) (Δ : hctx) → Set where
    V : ∀{d Δ} → d val → ok d Δ
    I : ∀{d Δ} → d indet → ok d Δ
    E : ∀{d Δ} → Δ ⊢ d err → ok d Δ
    S : ∀{d Δ} → Σ[ d' ∈ dhexp ] (Δ ⊢ d ↦ d') → ok d Δ

  progress : {Δ : hctx} {d : dhexp} {τ : htyp} →
             Δ , ∅ ⊢ d :: τ →
             ok d Δ
  progress TAConst = V VConst
  progress (TAVar x) = abort (somenotnone (! x))
  progress (TALam D) = V VLam
  progress (TAAp D1 x D2)
    with progress D1 | progress D2
  progress (TAAp TAConst () D2)       | V VConst | _
  progress {Δ = Δ} (TAAp D1 x₂ D2)    | V VLam | V x₁ = S {Δ = Δ} (_ , Step FDot (ITLam (FVal x₁)) FDot)
  progress (TAAp (TALam D1) MAArr D2) | V VLam | I x₁ = S (_ , Step (FAp1 (FVal VLam) {!!}) (ITLam (FIndet x₁)) {!!}) -- stuck on defining substitution
  progress (TAAp D1 x₂ D2)            | _   | E x₁ = E (EAp2 x₁)
  progress (TAAp D1 x₂ D2)            | E x | _    = E (EAp1 x)
  -- progress (TAAp D1 x₂ D2) | V x | S x₁ = {!!}
  progress (TAAp D1 x₂ D2) | I IEHole | V x₁ = I (IAp IEHole (FVal x₁))
  progress (TAAp D1 x₂ D2) | I (INEHole x) | V x₁ = I (IAp (INEHole x) (FVal x₁))
  progress (TAAp D1 x₃ D2) | I (IAp x x₁) | V x₂ = I (IAp (IAp x x₁) (FVal x₂))
  progress (TAAp D1 x₂ D2) | I (ICast x) | V x₁ = I (IAp (ICast x) (FVal x₁))
  progress (TAAp D1 x₂ D2) | I x | I x₁ = I (IAp x (FIndet x₁))
  progress (TAAp {d1 = d1} D1 x₄ D2) | _ | S (d , Step x₁ x₂ x₃) = S ((d1 ∘ d) , (Step {!!} (ITLam (FIndet {!!})) {!!}))
  progress (TAAp {d2 = d2} D1 x₂ D2) | S (π1 , π2) | _ = S ((π1 ∘ d2) , {!!})
  -- progress (TAAp D1 x₂ D2) | S x | I x₁ = {!!}
  -- progress (TAAp D1 x₂ D2) | S x | S x₁ = {!!}
  progress (TAEHole {m = ✓} x x₁) = I IEHole
  progress (TAEHole {m = ✗} x x₁) = S (_ , Step FDot ITEHole FDot)
  progress (TANEHole x D x₁)
    with progress D
  progress (TANEHole {m = ✓} x₁ D x₂) | V v = I (INEHole (FVal v))
  progress (TANEHole {m = ✗} x₁ D x₂) | V v = S (_ , Step FDot (ITNEHole (FVal v)) FDot)
  progress (TANEHole {m = ✓} x₁ D x₂) | I x = I (INEHole (FIndet x))
  progress (TANEHole {m = ✗} x₁ D x₂) | I x = S (_ , Step FDot (ITNEHole (FIndet x)) FDot)
  progress (TANEHole x₁ D x₂) | E x = E (ENEHole x)
  progress (TANEHole x₃ D x₄) | S (d , Step x x₁ x₂) = S (_ , (Step (FNEHole x) x₁ (FNEHole x₂)))
  progress (TACast D x)
    with progress D
  progress (TACast TAConst TCRefl)  | V VConst = E EConst
  progress (TACast TAConst TCHole2) | V VConst = E EConst
  progress (TACast D x₁) | V VLam
    with invert-lam D
  progress (TACast D TCRefl)        | V VLam | τ1 , τ2 , refl = {!!}
  progress (TACast D TCHole2)       | V VLam | τ1 , τ2 , refl = {!!}
  progress (TACast D (TCArr x₁ x₂)) | V VLam | τ1 , τ2 , refl = {!!}
  progress (TACast D x₁) | I x = I (ICast x)
  progress (TACast D x₁) | E x = E (ECastProp x)
  progress (TACast D x₃) | S (d , Step x x₁ x₂) = S ( _ , Step (FCast x) x₁ (FCast x₂))

open import Nat
open import Prelude
open import List
open import core
open import contexts
open import lemmas-consistency
open import canonical-forms

module progress where

  -- this is a little bit of syntactic sugar to avoid many layer nested Inl
  -- and Inrs that you would get from the more literal transcription of the
  -- consequent of progress as:
  --
  -- d val + d indet + d err[ Δ ] + Σ[ d' ∈ dhexp ] (Δ ⊢ d ↦ d')
  data ok : (d : dhexp) (Δ : hctx) → Set where
    V : ∀{d Δ} → d val → ok d Δ
    I : ∀{d Δ} → d indet → ok d Δ
    E : ∀{d Δ} → Δ ⊢ d err → ok d Δ
    S : ∀{d Δ} → Σ[ d' ∈ dhexp ] (Δ ⊢ d ↦ d') → ok d Δ

  progress : {Δ : hctx} {d : dhexp} {τ : htyp} →
             Δ , ∅ ⊢ d :: τ →
             ok d Δ
  progress TAConst = V VConst
  progress (TAVar x) = abort (somenotnone (! x))
  progress (TALam D) = V VLam
  progress (TAAp D1 x D2)
    with progress D1 | progress D2
  progress (TAAp TAConst () D2)       | V VConst | _
  progress {Δ = Δ} (TAAp D1 x₂ D2)    | V VLam | V x₁ = S {Δ = Δ} (_ , Step FRefl (ITLam (FVal x₁)) FRefl)
  progress (TAAp (TALam D1) MAArr D2) | V VLam | I x₁ = S (_ , Step (FAp1 (FVal VLam) {!!}) (ITLam (FIndet x₁)) {!!}) -- stuck on defining substitution
  progress (TAAp D1 x₂ D2)            | _   | E x₁ = E (EAp2 x₁)
  progress (TAAp D1 x₂ D2)            | E x | _    = E (EAp1 x)
  -- progress (TAAp D1 x₂ D2) | V x | S x₁ = {!!}
  progress (TAAp D1 x₂ D2) | I IEHole | V x₁ = I (IAp IEHole (FVal x₁))
  progress (TAAp D1 x₂ D2) | I (INEHole x) | V x₁ = I (IAp (INEHole x) (FVal x₁))
  progress (TAAp D1 x₃ D2) | I (IAp x x₁) | V x₂ = I (IAp (IAp x x₁) (FVal x₂))
  progress (TAAp D1 x₂ D2) | I (ICast x) | V x₁ = I (IAp (ICast x) (FVal x₁))
  progress (TAAp D1 x₂ D2) | I x | I x₁ = I (IAp x (FIndet x₁))
  progress (TAAp {d1 = d1} D1 x₄ D2) | _ | S (d , Step x₁ x₂ x₃) = S ((d1 ∘ d) , (Step {!!} (ITLam (FIndet {!!})) {!!}))
  progress (TAAp {d2 = d2} D1 x₂ D2) | S (π1 , π2) | _ = S ((π1 ∘ d2) , {!!})
  -- progress (TAAp D1 x₂ D2) | S x | I x₁ = {!!}
  -- progress (TAAp D1 x₂ D2) | S x | S x₁ = {!!}
  progress (TAEHole {m = ✓} x x₁) = I IEHole
  progress (TAEHole {m = ✗} x x₁) = S (_ , Step FRefl ITEHole FRefl)
  progress (TANEHole x D x₁)
    with progress D
  progress (TANEHole {m = ✓} x₁ D x₂) | V v = I (INEHole (FVal v))
  progress (TANEHole {m = ✗} x₁ D x₂) | V v = S (_ , Step FRefl (ITNEHole (FVal v)) FRefl)
  progress (TANEHole {m = ✓} x₁ D x₂) | I x = I (INEHole (FIndet x))
  progress (TANEHole {m = ✗} x₁ D x₂) | I x = S (_ , Step FRefl (ITNEHole (FIndet x)) FRefl)
  progress (TANEHole x₁ D x₂) | E x = E (ENEHole x)
  progress (TANEHole x₃ D x₄) | S (d , Step x x₁ x₂) = S (_ , (Step (FNEHole x) x₁ (FNEHole x₂)))
  progress (TACast D x)
    with progress D
  progress (TACast TAConst TCRefl)  | V VConst = E EConst
  progress (TACast TAConst TCHole2) | V VConst = E EConst
  progress (TACast D x₁) | V VLam
    with invert-lam D
  progress (TACast D TCRefl)        | V VLam | τ1 , τ2 , refl = {!!}
  progress (TACast D TCHole2)       | V VLam | τ1 , τ2 , refl = {!!}
  progress (TACast D (TCArr x₁ x₂)) | V VLam | τ1 , τ2 , refl = {!!}
  progress (TACast D x₁) | I x = I (ICast x)
  progress (TACast D x₁) | E x = E (ECastProp x)
  progress (TACast D x₃) | S (d , Step x x₁ x₂) = S ( _ , Step (FCast x) x₁ (FCast x₂))