module Data.Conat where
open import Coinduction
open import Data.Nat using (ℕ; zero; suc)
open import Relation.Binary
data Coℕ : Set where
zero : Coℕ
suc : (n : ∞ Coℕ) → Coℕ
fromℕ : ℕ → Coℕ
fromℕ zero = zero
fromℕ (suc n) = suc (♯ fromℕ n)
∞ℕ : Coℕ
∞ℕ = suc (♯ ∞ℕ)
infixl 6 _+_
infixl 5 _*_
_+_ : Coℕ → Coℕ → Coℕ
zero + n = n
suc m + n = suc (♯ (♭ m + n))
_*_ : Coℕ → Coℕ → Coℕ
zero * n = zero
suc m * n = go n module Star where
go : Coℕ → Coℕ
go' : Coℕ → Coℕ
go zero = zero
go (suc m) = go' (♭ m)
go' zero = suc (♯ (♭ m * n))
go' (suc m) = suc (♯ go' (♭ m))
toℕ : ℕ → Coℕ → ℕ
toℕ zero m = zero
toℕ (suc n) zero = zero
toℕ (suc n) (suc m) = suc (toℕ n (♭ m))
infix 2 _≈_
data _≈_ : Coℕ → Coℕ → Set where
zero : zero ≈ zero
suc : ∀ {m n} (m≈n : ∞ (♭ m ≈ ♭ n)) → suc m ≈ suc n
setoid : Setoid _ _
setoid = record
{ Carrier = Coℕ
; _≈_ = _≈_
; isEquivalence = record
{ refl = refl
; sym = sym
; trans = trans
}
}
where
refl : Reflexive _≈_
refl {zero} = zero
refl {suc n} = suc (♯ refl)
sym : Symmetric _≈_
sym zero = zero
sym (suc m≈n) = suc (♯ sym (♭ m≈n))
trans : Transitive _≈_
trans zero zero = zero
trans (suc m≈n) (suc n≈k) = suc (♯ trans (♭ m≈n) (♭ n≈k))