module Calf.Core.Cost where

open import Calf.Value
open import Calf.Value.Nat
open import Calf.Value.Unit
open import Cubical.Foundations.Prelude
open import Cubical.Data.Nat.Literals public
import Cubical.Data.Nat.Properties as Nat

module _ {A : Type} where
  open import Algebra.Definitions {A = A} _≑_ public

`_ = fromNat

opaque
  β„‚ : 𝒱
  β„‚ = β„•

  isSetβ„‚ : isSet β„‚
  isSetβ„‚ = isSetβ„•

  0β„‚ : β„‚
  0β„‚ = 0

  _+β„‚_ : β„‚ β†’ β„‚ β†’ β„‚
  _+β„‚_ = _+_

  +β„‚-identityΛ‘ : LeftIdentity 0β„‚ _+β„‚_
  +β„‚-identityΛ‘ _ = refl

  +β„‚-identityΚ³ : RightIdentity 0β„‚ _+β„‚_
  +β„‚-identityΚ³ = Nat.+-zero

  +β„‚-assoc : Associative _+β„‚_
  +β„‚-assoc c₁ cβ‚‚ c₃ = sym (Nat.+-assoc c₁ cβ‚‚ c₃)

  +β„‚-comm : Commutative _+β„‚_
  +β„‚-comm c₁ cβ‚‚ = Nat.+-comm c₁ cβ‚‚

  β„•β†’β„‚ : β„• β†’ β„‚
  β„•β†’β„‚ n = ` n

instance
  fromNatβ„‚ : HasFromNat β„‚
  fromNatβ„‚ = record { Constraint = Ξ» _ β†’ ⊀ ; fromNat = Ξ» n β†’ β„•β†’β„‚ n }

variable
  c c' c₁ cβ‚‚ : β„‚

_βŠ™_ : β„• β†’ β„‚ β†’ β„‚
zero βŠ™ c = 0β„‚
suc n βŠ™ c = c +β„‚ (n βŠ™ c)

βŠ™-+ : βˆ€ n c₁ cβ‚‚ β†’ n βŠ™ (c₁ +β„‚ cβ‚‚) ≑ (n βŠ™ c₁) +β„‚ (n βŠ™ cβ‚‚)
βŠ™-+ zero c₁ cβ‚‚ = sym (+β„‚-identityΛ‘ 0β„‚)
βŠ™-+ (suc n) c₁ cβ‚‚ =
    suc n βŠ™ (c₁ +β„‚ cβ‚‚)
  β‰‘βŸ¨ cong ((c₁ +β„‚ cβ‚‚) +β„‚_) (βŠ™-+ n c₁ cβ‚‚) ⟩
    (c₁ +β„‚ cβ‚‚) +β„‚ ((n βŠ™ c₁) +β„‚ (n βŠ™ cβ‚‚))
  β‰‘βŸ¨ +β„‚-assoc c₁ cβ‚‚ ((n βŠ™ c₁) +β„‚ (n βŠ™ cβ‚‚)) ⟩
    c₁ +β„‚ (cβ‚‚ +β„‚ ((n βŠ™ c₁) +β„‚ (n βŠ™ cβ‚‚)))
  β‰‘βŸ¨ cong (c₁ +β„‚_) (sym (+β„‚-assoc cβ‚‚ (n βŠ™ c₁) (n βŠ™ cβ‚‚))) ⟩
    c₁ +β„‚ ((cβ‚‚ +β„‚ (n βŠ™ c₁)) +β„‚ (n βŠ™ cβ‚‚))
  β‰‘βŸ¨ cong (Ξ» c β†’ c₁ +β„‚ (c +β„‚ (n βŠ™ cβ‚‚))) (+β„‚-comm cβ‚‚ (n βŠ™ c₁)) ⟩
    c₁ +β„‚ (((n βŠ™ c₁) +β„‚ cβ‚‚) +β„‚ (n βŠ™ cβ‚‚))
  β‰‘βŸ¨ cong (c₁ +β„‚_) (+β„‚-assoc (n βŠ™ c₁) cβ‚‚ (n βŠ™ cβ‚‚)) ⟩
    c₁ +β„‚ ((n βŠ™ c₁) +β„‚ (cβ‚‚ +β„‚ (n βŠ™ cβ‚‚)))
  β‰‘βŸ¨ sym (+β„‚-assoc c₁ (n βŠ™ c₁) (cβ‚‚ +β„‚ (n βŠ™ cβ‚‚))) ⟩
    (suc n βŠ™ c₁) +β„‚ (suc n βŠ™ cβ‚‚)
  ∎

βŠ™-+-left : βˆ€ n m c β†’ (n + m) βŠ™ c ≑ (n βŠ™ c) +β„‚ (m βŠ™ c)
βŠ™-+-left zero m c = sym (+β„‚-identityΛ‘ (m βŠ™ c))
βŠ™-+-left (suc n) m c =
    (suc n + m) βŠ™ c
  β‰‘βŸ¨ cong (c +β„‚_) (βŠ™-+-left n m c) ⟩
    c +β„‚ ((n βŠ™ c) +β„‚ (m βŠ™ c))
  β‰‘βŸ¨ sym (+β„‚-assoc c (n βŠ™ c) (m βŠ™ c)) ⟩
    (suc n βŠ™ c) +β„‚ (m βŠ™ c)
  ∎