{-# OPTIONS --safe #-}
module Cubical.Algebra.Module where

open import Cubical.Algebra.Module.Base public


{-# OPTIONS --cubical #-}
module Cubical.Codata.Stream where

open import Cubical.Codata.Stream.Base public

open import Cubical.Codata.Stream.Properties public


------------------------------------------------------------------------------
-- Properties for the bisimilarity relation
------------------------------------------------------------------------------

{-# OPTIONS --exact-split              #-}
{-# OPTIONS --no-sized-types           #-}
{-# OPTIONS --no-universe-polymorphism #-}
{-# OPTIONS --without-K                #-}

module FOTC.Relation.Binary.Bisimilarity.PropertiesATP where

open import FOTC.Base
open import FOTC.Base.List
open import FOTC.Data.Stream.Type
open import FOTC.Relation.Binary.Bisimilarity.Type

------------------------------------------------------------------------------
-- Because a greatest post-fixed point is a fixed-point, the
-- bisimilarity relation _≈_ on unbounded lists is also a pre-fixed
-- point of the bisimulation functional (see
-- FOTC.Relation.Binary.Bisimulation).

-- See Issue https://github.com/asr/apia/issues/81 .
≈-inB : D → D → Set
≈-inB xs ys = ∃[ x' ]  ∃[ xs' ] ∃[ ys' ]
                xs ≡ x' ∷ xs' ∧ ys ≡ x' ∷ ys' ∧ xs' ≈ ys'
{-# ATP definition ≈-inB #-}

≈-in : ∀ {xs ys} →
       ∃[ x' ]  ∃[ xs' ] ∃[ ys' ]
         xs ≡ x' ∷ xs' ∧ ys ≡ x' ∷ ys' ∧ xs' ≈ ys' →
       xs ≈ ys
≈-in h = ≈-coind ≈-inB h' h
  where
  postulate
    h' : ∀ {xs} {ys} → ≈-inB xs ys →
         ∃[ x' ] ∃[ xs' ] ∃[ ys' ] xs ≡ x' ∷ xs' ∧ ys ≡ x' ∷ ys' ∧ ≈-inB xs' ys'
  {-# ATP prove h' #-}

-- See Issue https://github.com/asr/apia/issues/81 .
≈-reflB : D → D → Set
≈-reflB xs ys = xs ≡ ys ∧ Stream xs
{-# ATP definition ≈-reflB #-}

≈-refl : ∀ {xs} → Stream xs → xs ≈ xs
≈-refl {xs} Sxs = ≈-coind ≈-reflB h₁ h₂
  where
  postulate
    h₁ : ∀ {xs ys} → ≈-reflB xs ys →
         ∃[ x' ] ∃[ xs' ] ∃[ ys' ] xs ≡ x' ∷ xs' ∧ ys ≡ x' ∷ ys' ∧ ≈-reflB xs' ys'
  {-# ATP prove h₁ #-}

  postulate h₂ : ≈-reflB xs xs
  {-# ATP prove h₂ #-}

-- See Issue https://github.com/asr/apia/issues/81 .
≈-symB : D → D → Set
≈-symB xs ys = ys ≈ xs
{-# ATP definition ≈-symB #-}

≈-sym : ∀ {xs ys} → xs ≈ ys → ys ≈ xs
≈-sym {xs} {ys} xs≈ys = ≈-coind ≈-symB h₁ h₂
  where
  postulate
    h₁ : ∀ {ys} {xs} → ≈-symB ys xs →
         ∃[ y' ] ∃[ ys' ] ∃[ xs' ] ys ≡ y' ∷ ys' ∧ xs ≡ y' ∷ xs' ∧ ≈-symB ys' xs'
  {-# ATP prove h₁ #-}

  postulate h₂ : ≈-symB ys xs
  {-# ATP prove h₂ #-}

-- See Issue https://github.com/asr/apia/issues/81 .
≈-transB : D → D → Set
≈-transB xs zs = ∃[ ys ] xs ≈ ys ∧ ys ≈ zs
{-# ATP definition ≈-transB #-}

≈-trans : ∀ {xs ys zs} → xs ≈ ys → ys ≈ zs → xs ≈ zs
≈-trans {xs} {ys} {zs} xs≈ys ys≈zs = ≈-coind ≈-transB h₁ h₂
  where
  postulate
    h₁ : ∀ {as} {cs} → ≈-transB as cs →
         ∃[ a' ] ∃[ as' ] ∃[ cs' ] as ≡ a' ∷ as' ∧ cs ≡ a' ∷ cs' ∧ ≈-transB as' cs'
  {-# ATP prove h₁ #-}

  postulate h₂ : ≈-transB xs zs
  {-# ATP prove h₂ #-}

postulate ∷-injective≈ : ∀ {x xs ys} → x ∷ xs ≈ x ∷ ys → xs ≈ ys
{-# ATP prove ∷-injective≈ #-}

postulate ∷-rightCong≈ : ∀ {x xs ys} → xs ≈ ys → x ∷ xs ≈ x ∷ ys
{-# ATP prove ∷-rightCong≈ ≈-in #-}


{-# OPTIONS --without-K --rewriting #-}

open import lib.Basics
open import lib.types.Coproduct
open import lib.types.Fin
open import lib.types.Int
open import lib.types.Nat
open import lib.types.Pi

module lib.types.Group where

-- 1-approximation of groups without higher coherence conditions.
record GroupStructure {i} (El : Type i) --(El-level : has-level 0 El)
  : Type i where
  constructor group-structure
  field
    ident  : El
    inv    : El → El
    comp   : El → El → El
    unit-l : ∀ a → comp ident a == a
    assoc  : ∀ a b c → comp (comp a b) c == comp a (comp b c)
    inv-l  : ∀ a → (comp (inv a) a) == ident

  ⊙El : Ptd i
  ⊙El = ⊙[ El , ident ]

  private
    infix 80 _⊙_
    _⊙_ = comp

  abstract
    inv-r  : ∀ g → g ⊙ inv g == ident
    inv-r g =
      g ⊙ inv g                           =⟨ ! $ unit-l (g ⊙ inv g) ⟩
      ident ⊙ (g ⊙ inv g)                 =⟨ ! $ inv-l (inv g) |in-ctx _⊙ (g ⊙ inv g) ⟩
      (inv (inv g) ⊙ inv g) ⊙ (g ⊙ inv g) =⟨ assoc (inv (inv g)) (inv g) (g ⊙ inv g) ⟩
      inv (inv g) ⊙ (inv g ⊙ (g ⊙ inv g)) =⟨ ! $ assoc (inv g) g (inv g) |in-ctx inv (inv g) ⊙_ ⟩
      inv (inv g) ⊙ ((inv g ⊙ g) ⊙ inv g) =⟨ inv-l g |in-ctx (λ h → inv (inv g) ⊙ (h ⊙ inv g)) ⟩
      inv (inv g) ⊙ (ident ⊙ inv g)       =⟨ unit-l (inv g) |in-ctx inv (inv g) ⊙_ ⟩
      inv (inv g) ⊙ inv g                 =⟨ inv-l (inv g) ⟩
      ident                               =∎

    unit-r : ∀ g → g ⊙ ident == g
    unit-r g =
      g ⊙ ident          =⟨ ! (inv-l g) |in-ctx g ⊙_ ⟩
      g ⊙ (inv g ⊙ g)    =⟨ ! $ assoc g (inv g) g ⟩
      (g ⊙ inv g) ⊙ g    =⟨ inv-r g |in-ctx _⊙ g ⟩
      ident ⊙ g          =⟨ unit-l g ⟩
      g                  =∎

    inv-unique-l : (g h : El) → (g ⊙ h == ident) → inv h == g
    inv-unique-l g h p =
      inv h              =⟨ ! (unit-l (inv h)) ⟩
      ident ⊙ inv h      =⟨ ! p |in-ctx (λ w → w ⊙ inv h) ⟩
      (g ⊙ h) ⊙ inv h    =⟨ assoc g h (inv h) ⟩
      g ⊙ (h ⊙ inv h)    =⟨ inv-r h |in-ctx (λ w → g ⊙ w) ⟩
      g ⊙ ident          =⟨ unit-r g ⟩
      g                  =∎

    inv-unique-r : (g h : El) → (g ⊙ h == ident) → inv g == h
    inv-unique-r g h p =
      inv g              =⟨ ! (unit-r (inv g)) ⟩
      inv g ⊙ ident      =⟨ ! p |in-ctx (λ w → inv g ⊙ w) ⟩
      inv g ⊙ (g ⊙ h)    =⟨ ! (assoc (inv g) g h) ⟩
      (inv g ⊙ g) ⊙ h    =⟨ inv-l g |in-ctx (λ w → w ⊙ h) ⟩
      ident ⊙ h          =⟨ unit-l h ⟩
      h                  =∎

    inv-ident : inv ident == ident
    inv-ident = inv-unique-l ident ident (unit-l ident)

    inv-comp : (g₁ g₂ : El) → inv (g₁ ⊙ g₂) == inv g₂ ⊙ inv g₁
    inv-comp g₁ g₂ =
      inv-unique-r (g₁ ⊙ g₂) (inv g₂ ⊙ inv g₁) $
        (g₁ ⊙ g₂) ⊙ (inv g₂ ⊙ inv g₁)
          =⟨ assoc g₁ g₂ (inv g₂ ⊙ inv g₁) ⟩
        g₁ ⊙ (g₂ ⊙ (inv g₂ ⊙ inv g₁))
          =⟨ ! (assoc g₂ (inv g₂) (inv g₁)) |in-ctx (λ w → g₁ ⊙ w) ⟩
        g₁ ⊙ ((g₂ ⊙ inv g₂) ⊙ inv g₁)
          =⟨ inv-r g₂ |in-ctx (λ w → g₁ ⊙ (w ⊙ inv g₁)) ⟩
        g₁ ⊙ (ident ⊙ inv g₁)
          =⟨ unit-l (inv g₁) |in-ctx (λ w → g₁ ⊙ w) ⟩
        g₁ ⊙ inv g₁
          =⟨ inv-r g₁ ⟩
        ident =∎

    inv-inv : (g : El) → inv (inv g) == g
    inv-inv g = inv-unique-r (inv g) g (inv-l g)

    inv-is-inj : is-inj inv
    inv-is-inj g₁ g₂ p = ! (inv-inv g₁) ∙ ap inv p ∙ inv-inv g₂

    cancel-l : (g : El) {h k : El} → g ⊙ h == g ⊙ k → h == k
    cancel-l g {h} {k} p =
      h                  =⟨ ! (unit-l h) ⟩
      ident ⊙ h          =⟨ ap (λ w → w ⊙ h) (! (inv-l g)) ⟩
      (inv g ⊙ g) ⊙ h    =⟨ assoc (inv g) g h ⟩
      inv g ⊙ (g ⊙ h)    =⟨ ap (λ w → inv g ⊙ w) p ⟩
      inv g ⊙ (g ⊙ k)    =⟨ ! (assoc (inv g) g k) ⟩
      (inv g ⊙ g) ⊙ k    =⟨ ap (λ w → w ⊙ k) (inv-l g) ⟩
      ident ⊙ k          =⟨ unit-l k ⟩
      k =∎

    cancel-r : (g : El) {h k : El} → h ⊙ g == k ⊙ g → h == k
    cancel-r g {h} {k} p =
      h                  =⟨ ! (unit-r h) ⟩
      h ⊙ ident          =⟨ ap (λ w → h ⊙ w) (! (inv-r g)) ⟩
      h ⊙ (g ⊙ inv g)    =⟨ ! (assoc h g (inv g)) ⟩
      (h ⊙ g) ⊙ inv g    =⟨ ap (λ w → w ⊙ inv g) p ⟩
      (k ⊙ g) ⊙ inv g    =⟨ assoc k g (inv g) ⟩
      k ⊙ (g ⊙ inv g)    =⟨ ap (λ w → k ⊙ w) (inv-r g) ⟩
      k ⊙ ident          =⟨ unit-r k ⟩
      k =∎

  conj : El → El → El
  conj g₁ g₂ = (g₁ ⊙ g₂) ⊙ inv g₁

  abstract
    conj-ident-r : ∀ g → conj g ident == ident
    conj-ident-r g = ap (_⊙ inv g) (unit-r _) ∙ inv-r g
  {- NOT USED
  abstract
    conj-unit-l : ∀ g → conj ident g == g
    conj-unit-l g = ap2 _⊙_ (unit-l _) inv-ident ∙ unit-r _

    conj-comp-l : ∀ g₁ g₂ g₃ → conj (g₁ ⊙ g₂) g₃ == conj g₁ (conj g₂ g₃)
    conj-comp-l g₁ g₂ g₃ =
      ((g₁ ⊙ g₂) ⊙ g₃) ⊙ inv (g₁ ⊙ g₂)
        =⟨ ap2 _⊙_ (assoc g₁ g₂ g₃) (inv-comp g₁ g₂) ⟩
      (g₁ ⊙ (g₂ ⊙ g₃)) ⊙ (inv g₂ ⊙ inv g₁)
        =⟨ ! $ assoc (g₁ ⊙ (g₂ ⊙ g₃)) (inv g₂) (inv g₁) ⟩
      ((g₁ ⊙ (g₂ ⊙ g₃)) ⊙ inv g₂) ⊙ inv g₁
        =⟨ assoc g₁ (g₂ ⊙ g₃) (inv g₂) |in-ctx _⊙ inv g₁ ⟩
      (g₁ ⊙ ((g₂ ⊙ g₃) ⊙ inv g₂)) ⊙ inv g₁
        =∎

    inv-conj : ∀ g₁ g₂ → inv (conj g₁ g₂) == conj g₁ (inv g₂)
    inv-conj g₁ g₂ = inv-comp (g₁ ⊙ g₂) (inv g₁)
                   ∙ ap2 _⊙_ (inv-inv g₁) (inv-comp g₁ g₂)
                   ∙ ! (assoc g₁ (inv g₂) (inv g₁))
  -}

  exp : El → ℤ → El
  exp g (pos 0) = ident
  exp g (pos 1) = g
  exp g (pos (S (S n))) = comp g (exp g (pos (S n)))
  exp g (negsucc 0) = inv g
  exp g (negsucc (S n)) = comp (inv g) (exp g (negsucc n))

  abstract
    exp-succ : ∀ g z → exp g (succ z) == comp g (exp g z)
    exp-succ g (pos 0) = ! (unit-r g)
    exp-succ g (pos 1) = idp
    exp-succ g (pos (S (S n))) = idp
    exp-succ g (negsucc 0) = ! (inv-r g)
    exp-succ g (negsucc (S n)) =
      ! (unit-l (exp g (negsucc n)))
      ∙ ap (λ h → comp h (exp g (negsucc n))) (! (inv-r g))
      ∙ assoc g (inv g) (exp g (negsucc n))

    exp-pred : ∀ g z → exp g (pred z) == comp (inv g) (exp g z)
    exp-pred g (pos 0) = ! (unit-r (inv g))
    exp-pred g (pos 1) = ! (inv-l g)
    exp-pred g (pos (S (S n))) =
      ! (unit-l (exp g (pos (S n))))
      ∙ ap (λ h → comp h (exp g (pos (S n)))) (! (inv-l g))
      ∙ assoc (inv g) g (exp g (pos (S n)))
    exp-pred g (negsucc 0) = idp
    exp-pred g (negsucc (S n)) = idp

    exp-+ : ∀ g z₁ z₂ → exp g (z₁ ℤ+ z₂) == comp (exp g z₁) (exp g z₂)
    exp-+ g (pos 0) z₂ = ! (unit-l _)
    exp-+ g (pos 1) z₂ = exp-succ g z₂
    exp-+ g (pos (S (S n))) z₂ =
      exp-succ g (pos (S n) ℤ+ z₂)
      ∙ ap (comp g) (exp-+ g (pos (S n)) z₂)
      ∙ ! (assoc g (exp g (pos (S n))) (exp g z₂))
    exp-+ g (negsucc 0) z₂ = exp-pred g z₂
    exp-+ g (negsucc (S n)) z₂ =
      exp-pred g (negsucc n ℤ+ z₂)
      ∙ ap (comp (inv g)) (exp-+ g (negsucc n) z₂)
      ∙ ! (assoc (inv g) (exp g (negsucc n)) (exp g z₂))

  exp-ident : ∀ z → exp ident z == ident
  exp-ident (pos 0) = idp
  exp-ident (pos 1) = idp
  exp-ident (pos (S (S n))) = unit-l _ ∙ exp-ident (pos (S n))
  exp-ident (negsucc 0) = inv-ident
  exp-ident (negsucc (S n)) = ap2 comp inv-ident (exp-ident (negsucc n)) ∙ unit-l _

  diff : El → El → El
  diff g h = g ⊙ inv h

  abstract
    zero-diff-same : (g h : El) → diff g h == ident → g == h
    zero-diff-same g h p = inv-is-inj g h $ inv-unique-r g (inv h) p

    inv-diff : (g h : El) → inv (diff g h) == diff h g
    inv-diff g h = inv-comp g (inv h) ∙ ap (_⊙ inv g) (inv-inv h)

  sum : ∀ {I : ℕ} → (Fin I → El) → El
  sum {I = O} f = ident
  sum {I = S n} f = comp (sum (f ∘ Fin-S)) (f (n , ltS))

  subsum-r : ∀ {j k} {I : ℕ} {A : Type j} {B : Type k}
    → (Fin I → Coprod A B) → (B → El) → El
  subsum-r p f = sum (λ x → ⊔-rec (λ _ → ident) f (p x))

record Group i : Type (lsucc i) where
  constructor group
  field
    El : Type i
    {{El-level}} : has-level 0 El
    group-struct : GroupStructure El
  open GroupStructure group-struct public

Group₀ : Type (lsucc lzero)
Group₀ = Group lzero

is-abelian : ∀ {i} → Group i → Type i
is-abelian G = (a b : Group.El G) → Group.comp G a b == Group.comp G b a

AbGroup : ∀ i → Type (lsucc i)
AbGroup i = Σ (Group i) is-abelian

AbGroup₀ : Type (lsucc lzero)
AbGroup₀ = AbGroup lzero

module AbGroup {i} (G : AbGroup i) where
  grp = fst G
  comm = snd G
  open Group grp public

  abstract
    interchange : (g₁ g₂ g₃ g₄ : El) →
        comp (comp g₁ g₂) (comp g₃ g₄)
        == comp (comp g₁ g₃) (comp g₂ g₄)
    interchange g₁ g₂ g₃ g₄ =
      comp (comp g₁ g₂) (comp g₃ g₄)
        =⟨ assoc g₁ g₂ (comp g₃ g₄) ⟩
      comp g₁ (comp g₂ (comp g₃ g₄))
        =⟨ comm g₃ g₄ |in-ctx (λ g → (comp g₁ (comp g₂ g))) ⟩
      comp g₁ (comp g₂ (comp g₄ g₃))
        =⟨ ! (assoc g₂ g₄ g₃) |in-ctx comp g₁ ⟩
      comp g₁ (comp (comp g₂ g₄) g₃)
        =⟨ comm (comp g₂ g₄) g₃ |in-ctx comp g₁ ⟩
      comp g₁ (comp g₃ (comp g₂ g₄))
        =⟨ ! (assoc g₁ g₃ (comp g₂ g₄)) ⟩
      comp (comp g₁ g₃) (comp g₂ g₄)
        =∎

    inv-comp' : ∀ g₁ g₂ → inv (comp g₁ g₂) == comp (inv g₁) (inv g₂)
    inv-comp' g₁ g₂ = inv-comp g₁ g₂ ∙ comm (inv g₂) (inv g₁)

    diff-comp : (g₁ g₂ g₃ g₄ : El) →
        diff (comp g₁ g₂) (comp g₃ g₄)
        == comp (diff g₁ g₃) (diff g₂ g₄)
    diff-comp g₁ g₂ g₃ g₄ =
        diff (comp g₁ g₂) (comp g₃ g₄)
          =⟨ ap (comp (comp g₁ g₂)) (inv-comp' g₃ g₄) ⟩
        comp (comp g₁ g₂) (comp (inv g₃) (inv g₄))
          =⟨ interchange g₁ g₂ (inv g₃) (inv g₄) ⟩
        comp (diff g₁ g₃) (diff g₂ g₄)
          =∎

    sum-comp : ∀ {I} (f g : Fin I → El)
      → sum (λ x → comp (f x) (g x)) == comp (sum f) (sum g)
    sum-comp {I = O} f g = ! (unit-l _)
    sum-comp {I = S I} f g =
        ap (λ x → comp x (comp (f (I , ltS)) (g (I , ltS)))) (sum-comp (f ∘ Fin-S) (g ∘ Fin-S))
      ∙ interchange (sum (f ∘ Fin-S)) (sum (g ∘ Fin-S)) (f (I , ltS)) (g (I , ltS))

    exp-comp : ∀ g₁ g₂ z → exp (comp g₁ g₂) z == comp (exp g₁ z) (exp g₂ z)
    exp-comp g₁ g₂ (pos O) = ! (unit-l _)
    exp-comp g₁ g₂ (pos (S O)) = idp
    exp-comp g₁ g₂ (pos (S (S n))) =
        ap (comp (comp g₁ g₂)) (exp-comp g₁ g₂ (pos (S n)))
      ∙ interchange g₁ g₂ (exp g₁ (pos (S n))) (exp g₂ (pos (S n)))
    exp-comp g₁ g₂ (negsucc O) = inv-comp' g₁ g₂
    exp-comp g₁ g₂ (negsucc (S n)) =
        ap2 comp (inv-comp' g₁ g₂) (exp-comp g₁ g₂ (negsucc n))
      ∙ interchange (inv g₁) (inv g₂) (exp g₁ (negsucc n)) (exp g₂ (negsucc n))

is-trivialᴳ : ∀ {i} (G : Group i) → Type i
is-trivialᴳ G = ∀ g → g == Group.ident G

contr-is-trivialᴳ : ∀ {i} (G : Group i)
  {{_ : is-contr (Group.El G)}} → is-trivialᴳ G
contr-is-trivialᴳ G g =
  contr-has-all-paths _ _

{- group-structure= -}

module _ where
  open GroupStructure

  abstract
    group-structure= : ∀ {i} {A : Type i} {{_ : is-set A}}
      {id₁ id₂ : A} {inv₁ inv₂ : A → A} {comp₁ comp₂ : A → A → A}
      → ∀ {unit-l₁ unit-l₂ assoc₁ assoc₂ inv-l₁ inv-l₂}
      → (id₁ == id₂) → (inv₁ == inv₂) → (comp₁ == comp₂)
      → Path {A = GroupStructure A}
          (group-structure id₁ inv₁ comp₁ unit-l₁ assoc₁ inv-l₁)
          (group-structure id₂ inv₂ comp₂ unit-l₂ assoc₂ inv-l₂)
    group-structure= {id₁ = id₁} {inv₁ = inv₁} {comp₁ = comp₁} idp idp idp =
      ap3 (group-structure id₁ inv₁ comp₁)
        (prop-has-all-paths _ _)
        (prop-has-all-paths _ _)
        (prop-has-all-paths _ _)

    ↓-group-structure= : ∀ {i} {A B : Type i}
      {{_ : has-level 0 A}}
      {GS : GroupStructure A} {HS : GroupStructure B} (p : A == B)
      → (ident GS == ident HS [ (λ C → C) ↓ p ])
      → (inv GS == inv HS [ (λ C → C → C) ↓ p ])
      → (comp GS == comp HS [ (λ C → C → C → C) ↓ p ])
      → GS == HS [ GroupStructure ↓ p ]
    ↓-group-structure= idp = group-structure=


{-# OPTIONS --safe --experimental-lossy-unification #-}
module Cubical.Algebra.Polynomials.Multivariate.EquivCarac.A[X]X-A where

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Function
open import Cubical.Foundations.Equiv
open import Cubical.Foundations.Isomorphism

open import Cubical.Data.Nat
open import Cubical.Data.Vec
open import Cubical.Data.Sigma
open import Cubical.Data.FinData

open import Cubical.Algebra.Ring
open import Cubical.Algebra.CommRing
open import Cubical.Algebra.CommRing.FGIdeal
open import Cubical.Algebra.CommRing.QuotientRing

open import Cubical.Algebra.Polynomials.Multivariate.Base
open import Cubical.Algebra.CommRing.Instances.Int renaming (ℤCommRing to ℤCR)
open import Cubical.Algebra.CommRing.Instances.MultivariatePoly
open import Cubical.Algebra.CommRing.Instances.MultivariatePoly-Quotient
open import Cubical.Algebra.CommRing.Instances.MultivariatePoly-notationZ

open import Cubical.Relation.Nullary

open import Cubical.HITs.SetQuotients as SQ
open import Cubical.HITs.PropositionalTruncation as PT

private variable
  ℓ : Level

-----------------------------------------------------------------------------
-- Functions

module Properties-Equiv-QuotientXn-A
  (Ar@(A , Astr) : CommRing ℓ)
  where

  private
    A[X] : CommRing ℓ
    A[X] = A[X1,···,Xn] Ar 1

    A[x] : Type ℓ
    A[x] = A[x1,···,xn] Ar 1

    A[X]/X : CommRing ℓ
    A[X]/X = A[X1,···,Xn]/<Xkʲ> Ar 1 0 1

    A[x]/x : Type ℓ
    A[x]/x = A[x1,···,xn]/<xkʲ> Ar 1 0 1

  open CommRingStr Astr using ()
    renaming
    ( 0r        to 0A
    ; 1r        to 1A
    ; _+_       to _+A_
    ; -_        to -A_
    ; _·_       to _·A_
    ; +Assoc    to +AAssoc
    ; +Identity to +AIdentity
    ; +Lid      to +ALid
    ; +Rid      to +ARid
    ; +Inv      to +AInv
    ; +Linv     to +ALinv
    ; +Rinv     to +ARinv
    ; +Comm     to +AComm
    ; ·Assoc    to ·AAssoc
    ; ·Identity to ·AIdentity
    ; ·Lid      to ·ALid
    ; ·Rid      to ·ARid
    ; ·Rdist+   to ·ARdist+
    ; ·Ldist+   to ·ALdist+
    ; is-set    to isSetA     )

  open CommRingStr (snd A[X] ) using ()
    renaming
    ( 0r        to 0PA
    ; 1r        to 1PA
    ; _+_       to _+PA_
    ; -_        to -PA_
    ; _·_       to _·PA_
    ; +Assoc    to +PAAssoc
    ; +Identity to +PAIdentity
    ; +Lid      to +PALid
    ; +Rid      to +PARid
    ; +Inv      to +PAInv
    ; +Linv     to +PALinv
    ; +Rinv     to +PARinv
    ; +Comm     to +PAComm
    ; ·Assoc    to ·PAAssoc
    ; ·Identity to ·PAIdentity
    ; ·Lid      to ·PALid
    ; ·Rid      to ·PARid
    ; ·Comm     to ·PAComm
    ; ·Rdist+   to ·PARdist+
    ; ·Ldist+   to ·PALdist+
    ; is-set    to isSetPA     )

  open CommRingStr (snd A[X]/X) using ()
    renaming
    ( 0r        to 0PAI
    ; 1r        to 1PAI
    ; _+_       to _+PAI_
    ; -_        to -PAI_
    ; _·_       to _·PAI_
    ; +Assoc    to +PAIAssoc
    ; +Identity to +PAIIdentity
    ; +Lid      to +PAILid
    ; +Rid      to +PAIRid
    ; +Inv      to +PAIInv
    ; +Linv     to +PAILinv
    ; +Rinv     to +PAIRinv
    ; +Comm     to +PAIComm
    ; ·Assoc    to ·PAIAssoc
    ; ·Identity to ·PAIIdentity
    ; ·Lid      to ·PAILid
    ; ·Rid      to ·PAIRid
    ; ·Rdist+   to ·PAIRdist+
    ; ·Ldist+   to ·PAILdist+
    ; is-set    to isSetPAI     )

  open RingTheory

-----------------------------------------------------------------------------
-- Direct sens

  A[x]→A : A[x] → A
  A[x]→A = Poly-Rec-Set.f _ _ _ isSetA
          0A
          base-trad
          _+A_
          +AAssoc
          +ARid
          +AComm
          base-neutral-eq
          base-add-eq

       where
       base-trad : _
       base-trad (zero ∷ []) a = a
       base-trad (suc k ∷ []) a = 0A

       base-neutral-eq : _
       base-neutral-eq (zero ∷ []) = refl
       base-neutral-eq (suc k ∷ []) = refl

       base-add-eq : _
       base-add-eq (zero ∷ []) a b = refl
       base-add-eq (suc k ∷ []) a b = +ARid _

  A[x]→A-pres1 : A[x]→A 1PA ≡ 1A
  A[x]→A-pres1 = refl

  A[x]→A-pres+ : (x y : A[x]) → (A[x]→A (x +PA y)) ≡ A[x]→A x +A A[x]→A y
  A[x]→A-pres+ x y = refl

  A[x]→A-pres· : (x y : A[x]) → (A[x]→A (x ·PA y)) ≡ A[x]→A x ·A A[x]→A y
  A[x]→A-pres· = Poly-Ind-Prop.f _ _ _
               (λ x u v i y → isSetA _ _ (u y) (v y) i)
               (λ y → sym (0LeftAnnihilates (CommRing→Ring Ar) _))
               (λ v a → Poly-Ind-Prop.f _ _ _ (λ _ → isSetA _ _)
                         (sym (0RightAnnihilates (CommRing→Ring Ar) _))
                         (λ v' a' → base-eq a a' v v')
                         (λ {U V} ind-U ind-V → cong₂ _+A_ ind-U ind-V ∙ sym (·ARdist+ _ _ _)))
               λ {U V} ind-U ind-V y → cong₂ _+A_ (ind-U y) (ind-V y) ∙ sym (·ALdist+ _ _ _)
            where
            base-eq : (a a' : A) → (v v' : Vec ℕ 1) → (A[x]→A (base v a ·PA base v' a')) ≡ A[x]→A (base v a) ·A A[x]→A (base v' a')
            base-eq a a' (zero ∷ []) (zero ∷ []) = refl
            base-eq a a' (zero ∷ []) (suc k' ∷ []) = sym (0RightAnnihilates (CommRing→Ring Ar) _)
            base-eq a a' (suc k ∷ []) (k' ∷ []) = sym (0LeftAnnihilates (CommRing→Ring Ar) _)

  A[X]→A : CommRingHom A[X] Ar
  fst A[X]→A = A[x]→A
  snd A[X]→A = makeIsRingHom A[x]→A-pres1 A[x]→A-pres+ A[x]→A-pres·

  A[x]→A-cancel : (k : Fin 1) → A[x]→A (<Xkʲ> Ar 1 0 1 k) ≡ 0A
  A[x]→A-cancel zero = refl

  A[X]/X→A : CommRingHom A[X]/X Ar
  A[X]/X→A = Quotient-FGideal-CommRing-CommRing.f A[X] Ar A[X]→A (<Xkʲ> Ar 1 0 1) A[x]→A-cancel

  A[x]/x→A : A[x]/x → A
  A[x]/x→A = fst A[X]/X→A

-----------------------------------------------------------------------------
-- Converse sens

  A→A[x] : A → A[x]
  A→A[x] a = base (0 ∷ []) a

  A→A[x]-pres+ : (a a' : A) → A→A[x] (a +A a') ≡ A→A[x] a +PA A→A[x] a'
  A→A[x]-pres+ a a' = sym (base-poly+ (0 ∷ []) a a')

  A→A[x]/x : A → A[x]/x
  A→A[x]/x = [_] ∘ A→A[x]

  A→A[x]/x-pres+ : (a a' : A) → A→A[x]/x (a +A a') ≡ A→A[x]/x a +PAI A→A[x]/x a'
  A→A[x]/x-pres+ a a' = cong [_] (A→A[x]-pres+ a a')

-----------------------------------------------------------------------------
-- Section sens

  e-sect : (a : A) → A[x]→A (A→A[x] a) ≡ a
  e-sect a = refl

-----------------------------------------------------------------------------
-- Retraction sens

  open IsRing

  e-retr : (x : A[x]/x) → A→A[x]/x (A[x]/x→A x) ≡ x
  e-retr = SQ.elimProp (λ x → isSetPAI _ _)
           (Poly-Ind-Prop.f _ _ _ (λ x → isSetPAI _ _)
           (cong [_] (base-0P _))
           (λ v a → base-eq a v)
           λ {U V} ind-U ind-V → cong [_] ((A→A[x]-pres+ _ _)) ∙ cong₂ _+PAI_ ind-U ind-V)

         where
         base-eq : (a : A) → (v : Vec ℕ 1) → A→A[x]/x (A[x]/x→A [ (base v a) ]) ≡ [ (base v a) ]
         base-eq a (zero ∷ []) = cong [_] refl
         base-eq a (suc k ∷ []) = eq/ (base (0 ∷ []) 0A) (base (suc k ∷ []) a) ∣ ((λ x → base (k ∷ []) (-A a)) , helper) ∣₁
           where
           helper : _
           helper = cong (λ X → X poly+ base (suc k ∷ []) (-A a)) (base-0P _)
                     ∙ +PALid _
                     ∙ sym (+PARid _
                            ∙ cong₂ base
                                    (cong (λ X → X ∷ []) (+-suc _ _ ∙ +-zero _))
                                    (·ARid _))

module _
  (Ar@(A , Astr) : CommRing ℓ)
  where

  open Iso
  open Properties-Equiv-QuotientXn-A Ar

  Equiv-A[X]/X-A : CommRingEquiv (A[X1,···,Xn]/<Xkʲ> Ar 1 0 1) Ar
  fst Equiv-A[X]/X-A = isoToEquiv is
    where
    is : Iso (A[x1,···,xn]/<xkʲ> Ar 1 0 1) A
    fun is = A[x]/x→A
    inv is = A→A[x]/x
    rightInv is = e-sect
    leftInv is = e-retr
  snd Equiv-A[X]/X-A = snd A[X]/X→A

Equiv-ℤ[X]/X-ℤ : RingEquiv (CommRing→Ring ℤ[X]/X) (CommRing→Ring ℤCR)
Equiv-ℤ[X]/X-ℤ = Equiv-A[X]/X-A ℤCR


module Instances where

open import Level using () renaming (zero to ℓ₀)
open import Category.Functor using (RawFunctor)
open import Data.Maybe as M using (Maybe)
open import Data.Nat using (ℕ)
open import Data.Product using (_×_ ; _,_ ; proj₁ ; proj₂)
open import Data.Vec using (Vec)
import Data.Vec.Equality
open Data.Vec.Equality.PropositionalEquality using () renaming (to-≡ to VecEq-to-≡)
open import Function using (_∘_ ; id)
open import Relation.Binary using (Setoid ; module Setoid)
open import Relation.Binary.Indexed using (_at_) renaming (Setoid to ISetoid)
open import Relation.Binary.PropositionalEquality as P using (_≡_ ; _≗_ ; module ≡-Reasoning)

open Setoid using () renaming (_≈_ to _∋_≈_)

open import Generic using (VecISetoid)
open import Structures using (Functor ; Shaped ; module Shaped)

MaybeFunctor : Functor Maybe
MaybeFunctor = record
  { rawfunctor = M.functor
  ; isFunctor = record
    { cong = cong
    ; identity = identity
    ; composition = composition
    } }
  where _<$>_ : {α β : Set} → (α → β) → Maybe α → Maybe β
        _<$>_ = RawFunctor._<$>_ M.functor

        cong : {α β : Set} {g h : α → β} → g ≗ h → _<$>_ g ≗ _<$>_ h
        cong g≗h (M.just x) = P.cong M.just (g≗h x)
        cong g≗h M.nothing  = P.refl

        identity : {α : Set} → _<$>_ {α} id ≗ id
        identity (M.just x) = P.refl
        identity M.nothing  = P.refl

        composition : {α β γ : Set} → (g : β → γ) → (h : α → β) → _<$>_ (g ∘ h) ≗ _<$>_ g ∘ _<$>_ h
        composition g h (M.just x) = P.refl
        composition g h M.nothing  = P.refl

VecShaped : Shaped ℕ Vec
VecShaped = record
  { arity = id
  ; content = id
  ; fill = λ _ → id
  ; isShaped = record
    { content-fill = λ _ → P.refl
    ; fill-content = λ _ _ → P.refl
    } }

ShapedISetoid : (S : Setoid ℓ₀ ℓ₀) {C : Set → (Setoid.Carrier S) → Set} → Shaped (Setoid.Carrier S) C → Setoid ℓ₀ ℓ₀ → ISetoid (Setoid.Carrier S) ℓ₀ ℓ₀
ShapedISetoid S {C} ShapeT α = record
  { Carrier = C (Setoid.Carrier α)
  ; _≈_ = λ {s₁} {s₂} c₁ c₂ → S ∋ s₁ ≈ s₂ × ISetoid._≈_ (VecISetoid α) (content c₁) (content c₂)
  ; isEquivalence = record
    { refl = Setoid.refl S , ISetoid.refl (VecISetoid α)
    ; sym = λ p → Setoid.sym S (proj₁ p) , ISetoid.sym (VecISetoid α) (proj₂ p)
    ; trans = λ p q → Setoid.trans S (proj₁ p) (proj₁ q) , ISetoid.trans (VecISetoid α) (proj₂ p) (proj₂ q)
    } } where open Shaped ShapeT

Shaped≈-to-≡ : {S : Set} {C : Set → S → Set} → (ShapeT : Shaped S C) → (α : Set) → {s : S} {x y : C α s} → ShapedISetoid (P.setoid S) ShapeT (P.setoid α) at s ∋ x ≈ y → x ≡ y
Shaped≈-to-≡ ShapeT α {s} {x} {y} (shape≈ , content≈) = begin
  x
    ≡⟨ P.sym (content-fill x) ⟩
  fill s (content x)
    ≡⟨ P.cong (fill s) (VecEq-to-≡ content≈) ⟩
  fill s (content y)
    ≡⟨ content-fill y ⟩
  y ∎
  where open ≡-Reasoning
        open Shaped ShapeT


{-# OPTIONS --cubical --safe #-}
module Cubical.Data.DescendingList where

open import Cubical.Data.DescendingList.Base public
open import Cubical.Data.DescendingList.Properties public


{-# OPTIONS --without-K #-}

open import Prelude
import GSeTT.Typed-Syntax
import Globular-TT.Syntax
import Globular-TT.Rules

module Globular-TT.Globular-TT {l} (index : Set l) (rule : index → GSeTT.Typed-Syntax.Ctx × (Globular-TT.Syntax.Pre-Ty index))
                                                   (assumption : Globular-TT.Rules.well-founded index rule)
                                                   (eqdec-index : eqdec index)
                                                   where

  open import Globular-TT.Syntax index
  open import Globular-TT.Eqdec-syntax index eqdec-index
  open import Globular-TT.Rules index rule
  open import Globular-TT.CwF-Structure index rule
  open import Globular-TT.Uniqueness-Derivations index rule eqdec-index
  open import Globular-TT.Disks index rule eqdec-index
  open import Globular-TT.Typed-Syntax index rule eqdec-index
  open import Globular-TT.Dec-Type-Checking index rule assumption eqdec-index


------------------------------------------------------------------------
-- The Agda standard library
--
-- Properties related to Linked
------------------------------------------------------------------------

{-# OPTIONS --without-K --safe #-}

module Data.List.Relation.Unary.Linked.Properties where

open import Data.List hiding (any)
open import Data.List.Relation.Unary.AllPairs as AllPairs
  using (AllPairs; []; _∷_)
open import Data.List.Relation.Unary.All using (All; []; _∷_)
open import Data.List.Relation.Unary.Linked as Linked
  using (Linked; []; [-]; _∷_)
open import Data.Fin.Base using (Fin)
open import Data.Fin.Properties using (suc-injective)
open import Data.Nat.Base using (zero; suc; _<_; z≤n; s≤s)
open import Data.Nat.Properties using (≤-refl; ≤-pred; ≤-step)
open import Level using (Level)
open import Function using (_∘_; flip)
open import Relation.Binary using (Rel; Transitive; DecSetoid)
open import Relation.Binary.PropositionalEquality using (_≢_)
open import Relation.Unary using (Pred; Decidable)
open import Relation.Nullary using (yes; no)

private
  variable
    a b p ℓ : Level
    A : Set a
    B : Set b

------------------------------------------------------------------------
-- Relationship to other predicates
------------------------------------------------------------------------

module _ {R : Rel A ℓ} where

  AllPairs⇒Linked : ∀ {xs} → AllPairs R xs → Linked R xs
  AllPairs⇒Linked []                    = []
  AllPairs⇒Linked (px ∷ [])             = [-]
  AllPairs⇒Linked ((px ∷ _) ∷ py ∷ pxs) =
    px ∷ (AllPairs⇒Linked (py ∷ pxs))

module _ {R : Rel A ℓ} (trans : Transitive R) where

  Linked⇒All : ∀ {v x xs} → R v x →
               Linked R (x ∷ xs) → All (R v) (x ∷ xs)
  Linked⇒All Rvx [-]         = Rvx ∷ []
  Linked⇒All Rvx (Rxy ∷ Rxs) = Rvx ∷ Linked⇒All (trans Rvx Rxy) Rxs

  Linked⇒AllPairs : ∀ {xs} → Linked R xs → AllPairs R xs
  Linked⇒AllPairs []          = []
  Linked⇒AllPairs [-]         = [] ∷ []
  Linked⇒AllPairs (Rxy ∷ Rxs) = Linked⇒All Rxy Rxs ∷ Linked⇒AllPairs Rxs

------------------------------------------------------------------------
-- Introduction (⁺) and elimination (⁻) rules for list operations
------------------------------------------------------------------------
-- map

module _ {R : Rel A ℓ} {f : B → A} where

  map⁺ : ∀ {xs} → Linked (λ x y → R (f x) (f y)) xs →
         Linked R (map f xs)
  map⁺ []           = []
  map⁺ [-]          = [-]
  map⁺ (Rxy ∷ Rxs)  = Rxy ∷ map⁺ Rxs

------------------------------------------------------------------------
-- applyUpTo

module _ {R : Rel A ℓ} where

  applyUpTo⁺₁ : ∀ f n → (∀ {i} → suc i < n → R (f i) (f (suc i))) →
                Linked R (applyUpTo f n)
  applyUpTo⁺₁ f zero          Rf = []
  applyUpTo⁺₁ f (suc zero)    Rf = [-]
  applyUpTo⁺₁ f (suc (suc n)) Rf =
    Rf (s≤s (s≤s z≤n)) ∷ (applyUpTo⁺₁ (f ∘ suc) (suc n) (Rf ∘ s≤s))

  applyUpTo⁺₂ : ∀ f n → (∀ i → R (f i) (f (suc i))) →
                Linked R (applyUpTo f n)
  applyUpTo⁺₂ f n Rf = applyUpTo⁺₁ f n (λ _ → Rf _)

------------------------------------------------------------------------
-- applyDownFrom

module _ {R : Rel A ℓ} where

  applyDownFrom⁺₁ : ∀ f n → (∀ {i} → suc i < n → R (f (suc i)) (f i)) →
                    Linked R (applyDownFrom f n)
  applyDownFrom⁺₁ f zero          Rf = []
  applyDownFrom⁺₁ f (suc zero)    Rf = [-]
  applyDownFrom⁺₁ f (suc (suc n)) Rf =
    Rf ≤-refl ∷ applyDownFrom⁺₁ f (suc n) (Rf ∘ ≤-step)

  applyDownFrom⁺₂ : ∀ f n → (∀ i → R (f (suc i)) (f i)) →
                    Linked R (applyDownFrom f n)
  applyDownFrom⁺₂ f n Rf = applyDownFrom⁺₁ f n (λ _ → Rf _)


module RecordConstructors (Parameter : Set) where

-- Note that the fixity declaration has to be given outside of the
-- record definition.

infix 6 _⟨_⟩_

record R (X : Set) (Y : Set) : Set₁ where
  constructor _⟨_⟩_
  field
    {A}       : Set
    f         : A → X
    {B} D {E} : Set
    g         : B → Y → E

postulate A : Set

r : R A A
r = f ⟨ A ⟩ λ (_ : A) → f
  where
  f : A → A
  f x = x

data _≡_ {A : Set₁} (x : A) : A → Set where
  refl : x ≡ x

lemma : r ≡ record {}
lemma = refl

-- Record constructors can be overloaded.

record R′ : Set₁ where
  constructor _⟨_⟩_
  field
    T₁ T₂ T₃ : Set

data D : Set where
  _⟨_⟩_ : D

r′ : R′
r′ = A ⟨ A ⟩ A

d : D
d = _⟨_⟩_


module Data.Num where

open import Data.List using (List; []; _∷_; foldr)
open import Data.Nat
open ≤-Reasoning

open import Data.Nat.Etc
open import Data.Nat.DivMod
open import Data.Nat.DivMod.Properties using (div-mono)
open import Data.Nat.Properties using (m≤m+n; n≤m+n;_+-mono_; pred-mono; ∸-mono; ≰⇒>; n∸n≡0; +-∸-assoc; m+n∸n≡m)
open import Data.Nat.Properties.Simple using (+-right-identity; +-suc; +-assoc; +-comm; distribʳ-*-+)
open import Data.Fin.Properties using (bounded)
open import Data.Fin using (Fin; fromℕ≤; inject≤; #_)
    renaming (toℕ to F→N; fromℕ to N→F; zero to Fz; suc to Fs)
open import Data.Product
open import Data.Maybe

open import Induction.Nat using (rec; Rec)
import Level
open import Function
open import Data.Unit using (tt)
open import Relation.Nullary
open import Relation.Nullary.Decidable using (True; False; toWitness; toWitnessFalse; fromWitness; fromWitnessFalse)
open import Relation.Nullary.Negation using (contradiction; contraposition)
open import Relation.Binary

open import Relation.Binary.PropositionalEquality as PropEq
    using (_≡_; _≢_; refl; cong; sym; trans; inspect)
open PropEq.≡-Reasoning
    renaming (begin_ to beginEq_; _≡⟨_⟩_ to _≡Eq⟨_⟩_; _∎ to _∎Eq)
-- Surjective (ℕm):
--  base = 1, digits = {m ... (m + n) - 1}, m ≥ 1, n ≥ m
--  base > 1, digits = {m ... (m + n) - 1}, m ≥ 0, n ≥ max base (base × m)
-- Bijective:
--  base ≥ 1, digits = {1 .. base}
--
--  Digits:
--    Digit m n represents a Digit ranging from m to (m + n - 1)
--    e.g. Digit 2 0 2 = {0, 1}         for ordinary binary number
--         Digit 2 1 2 = {1, 2}         for zeroless binary number
--         Digit 2 0 3 = {0, 1, 2}      for redundant binary number
--
data Digit : (base from range : ℕ) → Set where
    -- unary digit: {0, 1 .. n-1}
    U0 : ∀ {n} → Fin n
         → {2≤n : True (2 ≤? n)} -- i.e. must have digit '1'
         → Digit 1 0 n
    -- unary digit: {m .. m+n-1}
    U1 : ∀ {m n}
         → Fin n
         → {m≤n : True (suc m ≤? n)}
         → Digit 1 (suc m) n
    -- k-adic digit: {m .. m+n-1}
    D  : ∀ {b m n}
         → Fin n
         → let base = suc (suc b) in
           {b≤n : True (base ≤? n)} → {bm≤n : True ((base * m) ≤? n)}
         → Digit base m n

-- without offset, {0 .. n-1}
D→F : ∀ {b m n} → Digit b m n → Fin n
D→F (U0 x) = x
D→F (U1 x) = x
D→F (D x) = x

-- with offset, {m .. m+n-1}
D→N : ∀ {b m n} → Digit b m n → ℕ
D→N {m = m} d = m + F→N (D→F d)

-- infix 4 _D≤_ -- _D<_ _≥′_ _>′_

-- data _D≤_ {b m n} (x : Digit b m n) : (y : Digit b m n) → Set where
--   D≤-refl :                          x D≤ x
--  D≤-step : ∀ {y} (xD≤y : x D≤ y) → x D≤
  -- ≤′-step : ∀ {n} (m≤′n : m ≤′ n) → m ≤′ suc n

private

    -- alias
    ℕ-isDecTotalOrder   = DecTotalOrder.isDecTotalOrder decTotalOrder
    ℕ-isTotalOrder      = IsDecTotalOrder.isTotalOrder ℕ-isDecTotalOrder
    ℕ-isPartialOrder    = IsTotalOrder.isPartialOrder ℕ-isTotalOrder
    ℕ-isPreorder        = IsPartialOrder.isPreorder ℕ-isPartialOrder
    ≤-refl      = IsPreorder.reflexive ℕ-isPreorder
    ≤-antisym   = IsPartialOrder.antisym ℕ-isPartialOrder
    ≤-total     = IsTotalOrder.total ℕ-isTotalOrder

    -- helper function for adding two 'Fin n' with offset 'm'
    -- (m + x) + (m + y) - m = m + x + y
    D+sum : ∀ {n} (m : ℕ) → (x y : Fin n) → ℕ
    D+sum m x y = m + (F→N x) + (F→N y)

maxpress-pred : ℕ → Set
maxpress-pred _ = ℕ → ℕ

maxpress-rec-struct : (x : ℕ) → Rec Level.zero maxpress-pred x → (bound : ℕ) → ℕ
maxpress-rec-struct zero p bound = 0
maxpress-rec-struct (suc x) p bound with bound ≤? suc (p bound)
maxpress-rec-struct (suc x) p bound | yes q = suc (p bound) ∸ bound
maxpress-rec-struct (suc x) p bound | no ¬q = suc (p bound)

-- if x ≥ bound, then substract bound from x, until x < bound
maxpress : (x bound : ℕ) → ℕ
maxpress = rec maxpress-pred maxpress-rec-struct

maxpressed<bound : (x bound : ℕ) → (≢0 : False (bound ≟ 0)) → maxpress x bound < bound
maxpressed<bound zero    zero        ()
maxpressed<bound zero    (suc bound) ≢0 = s≤s z≤n
maxpressed<bound (suc x) zero        ()
maxpressed<bound (suc x) (suc bound) ≢0 with suc bound ≤? suc (maxpress x (suc bound))
maxpressed<bound (suc x) (suc bound) ≢0 | yes p =
    begin
        suc (maxpress x (suc bound) ∸ bound)
    ≤⟨ ≤-refl (sym (+-∸-assoc 1 p)) ⟩
        suc (maxpress x (suc bound)) ∸ bound
    ≤⟨ ∸-mono {suc (maxpress x (suc bound))} {suc bound} {bound} {bound} (maxpressed<bound x (suc bound) tt) (≤-refl refl) ⟩
        suc bound ∸ bound
    ≤⟨ ≤-refl (m+n∸n≡m 1 bound) ⟩
        suc zero
    ≤⟨ s≤s z≤n ⟩
        suc bound
    ∎
maxpressed<bound (suc x) (suc bound) ≢0 | no ¬p = ≰⇒> ¬p

maxpress′ : (x bound : ℕ) → (≢0 : False (bound ≟ 0)) → Fin bound
maxpress′ x bound ≢0 = fromℕ≤ {maxpress x bound} (maxpressed<bound x bound ≢0)

_D+_ : ∀ {b m n} → Digit b m n → Digit b m n → Digit b m n
_D+_ {zero}                ()     ()
_D+_ {suc zero}            x      _      = x
_D+_ {suc (suc b)} {m} {n} (D x) (D y {b≤n} {bm≤n}) = D (maxpress′ (D+sum m x y) n n≢0) {b≤n} {bm≤n}
    where   n≢0 = fromWitnessFalse $ >⇒≢ $
                begin
                    suc zero
                ≤⟨ s≤s z≤n ⟩
                    suc (suc b)
                ≤⟨ toWitness b≤n ⟩
                    n
                ∎

--      2 ≤ base
--  ⇒  max * 2 ≤ max * base
--  ⇒  max * 2 / base ≤ max

{-
_D⊕_ : ∀ {b m n} → Digit b m n → Digit b m n → Maybe (Digit b m n)
_D⊕_                       (U0 x) y = just y
_D⊕_                       (U1 x) y = just y
_D⊕_ {suc (suc b)} {m} {n} (D x) (D y) with suc (D+sum m x y) ≤? n
_D⊕_ {suc (suc b)} {m} {n} (D x) (D y) | yes p = nothing
_D⊕_ {suc (suc b)} {m} {n} (D x) (D y {b≤n} {bm≤n}) | no ¬p with D+sum m x y divMod (suc (suc b)) | inspect (λ w → _divMod_ (D+sum m x y) (suc (suc b)) {≢0 = w}) tt
_D⊕_ {suc (suc b)} {m} {n} (D x) (D y {b≤n} {bm≤n}) | no ¬p | result quotient remainder property | PropEq.[ eq ] =
    let base = suc (suc b)
        sum = D+sum m x y
        quotient<n = begin
                suc quotient
            ≤⟨ div-mono base tt {!    !} ⟩
                {!   !}
            ≤⟨ {!   !} ⟩
                {!   !}
            ≤⟨ {!   !} ⟩
                {!   !}
            ≤⟨ {!   !} ⟩
                n
            ∎
    in  just (D (fromℕ≤ {quotient} quotient<n) {b≤n} {bm≤n})
-}
{-
    let base = suc (suc b)
        sum = D+sum m x y
        result quotient remainder property = _divMod_ sum base {tt}
        quotient<n = begin
                DivMod.quotient (sum divMod {! base  !})
            ≤⟨ {!   !} ⟩
                {!   !}
            ≤⟨ {!   !} ⟩
                {!   !}
            ≤⟨ {!   !} ⟩
                {!   !}
            ≤⟨ {!   !} ⟩
                n
            ∎
    in  just (D (fromℕ≤ {quotient} quotient<n) {b≤n} {bm≤n})
-}
{-

    begin
        {!   !}
    <⟨ {!   !} ⟩
        {!   !}
    <⟨ {!   !} ⟩
        {!   !}
    ∎

    begin
        {!   !}
    ≤⟨ {!    !} ⟩
        {!    !}
    ≤⟨ {!    !} ⟩
        {!   !}
    ≤⟨ {!    !} ⟩
        {!   !}
    ≤⟨ {!    !} ⟩
        {!   !}
    ∎
    beginEq
        {!   !}
    ≡Eq⟨ {!   !} ⟩
        {!   !}
    ≡Eq⟨ {!   !} ⟩
        {!   !}
    ≡Eq⟨ {!   !} ⟩
        {!   !}
    ≡Eq⟨ {!   !} ⟩
        {!   !}
    ∎Eq
-}

data System : (base from range : ℕ) → Set where
    Sys : ∀ {b m n} → List (Digit (suc b) m n) → System (suc b) m n
{-
_S+_ : ∀ {b m n} → System b m n → System b m n → System b m n
Sys []       S+ Sys ys = Sys ys
Sys xs       S+ Sys [] = Sys xs
Sys (x ∷ xs) S+ Sys (y ∷ ys) = {! x  !}

S→N : ∀ {b m n} → System b m n → ℕ
S→N {zero} ()
S→N {suc b} (Sys list) = foldr (shift-then-add (suc b)) 0 list
    where   shift-then-add : ∀ {m n} → (b : ℕ) → Digit b m n → ℕ → ℕ
            shift-then-add b x acc = (D→N x) + (acc * b)
-}
--
--  Example
--

private
    one : Digit 2 1 2
    one = D Fz

    two : Digit 2 1 2
    two = D (Fs Fz)

    u0 : Digit 1 0 2
    u0 = U0 Fz

    u1 : Digit 1 1 1
    u1 = U1 Fz

    a0 : Digit 3 0 4
    a0 = D Fz

    a1 : Digit 3 0 4
    a1 = D (Fs Fz)

    a2 : Digit 3 0 4
    a2 = D (Fs (Fs Fz))

    a3 : Digit 3 0 4
    a3 = D (Fs (Fs (Fs Fz)))

    a : System 2 1 2
    a = Sys (one ∷ two ∷ two ∷ [])


------------------------------------------------------------------------
-- The Agda standard library
--
-- Simple combinators working solely on and with functions
------------------------------------------------------------------------

-- The contents of this file can be accessed from `Function`.

{-# OPTIONS --without-K --safe #-}

module Function.Base where

open import Level
open import Strict

private
  variable
    a b c d e : Level
    A : Set a
    B : Set b
    C : Set c
    D : Set d
    E : Set e

------------------------------------------------------------------------
-- Some simple functions

id : A → A
id x = x

const : A → B → A
const x = λ _ → x

------------------------------------------------------------------------
-- Operations on dependent functions

-- These are functions whose output has a type that depends on the
-- value of the input to the function.

infixr 9 _∘_
infixl 8 _ˢ_
infixl 0 _|>_
infix  0 case_return_of_
infixr -1 _$_ _$!_

-- Composition

_∘_ : ∀ {A : Set a} {B : A → Set b} {C : {x : A} → B x → Set c} →
      (∀ {x} (y : B x) → C y) → (g : (x : A) → B x) →
      ((x : A) → C (g x))
f ∘ g = λ x → f (g x)

-- Flipping order of arguments

flip : ∀ {A : Set a} {B : Set b} {C : A → B → Set c} →
       ((x : A) (y : B) → C x y) → ((y : B) (x : A) → C x y)
flip f = λ y x → f x y

-- Application - note that _$_ is right associative, as in Haskell.
-- If you want a left associative infix application operator, use
-- Category.Functor._<$>_ from Category.Monad.Identity.IdentityMonad.

_$_ : ∀ {A : Set a} {B : A → Set b} →
      ((x : A) → B x) → ((x : A) → B x)
f $ x = f x

-- Strict (call-by-value) application

_$!_ : ∀ {A : Set a} {B : A → Set b} →
       ((x : A) → B x) → ((x : A) → B x)
_$!_ = flip force

-- Flipped application (aka pipe-forward)

_|>_ : ∀ {A : Set a} {B : A → Set b} →
       (a : A) → (∀ a → B a) → B a
_|>_ = flip _$_

-- The S combinator - written infix as in Conor McBride's paper
-- "Outrageous but Meaningful Coincidences: Dependent type-safe syntax
-- and evaluation".

_ˢ_ : ∀ {A : Set a} {B : A → Set b} {C : (x : A) → B x → Set c} →
      ((x : A) (y : B x) → C x y) →
      (g : (x : A) → B x) →
      ((x : A) → C x (g x))
f ˢ g = λ x → f x (g x)

-- Converting between implicit and explicit function spaces.

_$- : ∀ {A : Set a} {B : A → Set b} → ((x : A) → B x) → ({x : A} → B x)
f $- = f _

λ- : ∀ {A : Set a} {B : A → Set b} → ({x : A} → B x) → ((x : A) → B x)
λ- f = λ x → f

-- Case expressions (to be used with pattern-matching lambdas, see
-- README.Case).

case_return_of_ : ∀ {A : Set a} (x : A) (B : A → Set b) →
                  ((x : A) → B x) → B x
case x return B of f = f x

------------------------------------------------------------------------
-- Non-dependent versions of dependent operations

-- Any of the above operations for dependent functions will also work
-- for non-dependent functions but sometimes Agda has difficulty
-- inferring the non-dependency. Primed (′ = \prime) versions of the
-- operations are therefore provided below that sometimes have better
-- inference properties.

infixr 9 _∘′_
infixl 0 _|>′_
infix  0 case_of_
infixr -1 _$′_ _$!′_

-- Composition

_∘′_ : (B → C) → (A → B) → (A → C)
f ∘′ g = _∘_ f g

-- Application

_$′_ : (A → B) → (A → B)
_$′_ = _$_

-- Strict (call-by-value) application

_$!′_ : (A → B) → (A → B)
_$!′_ = _$!_

-- Flipped application (aka pipe-forward)

_|>′_ : A → (A → B) → B
_|>′_ = _|>_

-- Case expressions (to be used with pattern-matching lambdas, see
-- README.Case).

case_of_ : A → (A → B) → B
case x of f = case x return _ of f

------------------------------------------------------------------------
-- Operations that are only defined for non-dependent functions

infixr 0 _-[_]-_
infixl 1 _on_
infixl 1 _⟨_⟩_
infixl 0 _∋_

-- Binary application

_⟨_⟩_ : A → (A → B → C) → B → C
x ⟨ f ⟩ y = f x y

-- Composition of a binary function with a unary function

_on_ : (B → B → C) → (A → B) → (A → A → C)
_*_ on f = λ x y → f x * f y

-- Composition of three binary functions

_-[_]-_ : (A → B → C) → (C → D → E) → (A → B → D) → (A → B → E)
f -[ _*_ ]- g = λ x y → f x y * g x y

-- In Agda you cannot annotate every subexpression with a type
-- signature. This function can be used instead.

_∋_ : (A : Set a) → A → A
A ∋ x = x

-- Conversely it is sometimes useful to be able to extract the
-- type of a given expression.

typeOf : {A : Set a} → A → Set a
typeOf {A = A} _ = A

-- Construct an element of the given type by instance search.

it : {A : Set a} → {{A}} → A
it {{x}} = x


{- Next step operator. -}
module TemporalOps.Next where

open import CategoryTheory.Categories
open import CategoryTheory.Instances.Reactive
open import CategoryTheory.Functor
open import CategoryTheory.CartesianStrength
open import TemporalOps.Common

open import Data.Product
open import Data.Sum

-- One-step delay operator.
▹_ : τ -> τ
(▹ A) zero    = ⊤ zero
(▹ A) (suc n) = A n
infixr 70 ▹_

-- Functor instance for ▹
F-▹ : Endofunctor ℝeactive
F-▹ = record
    { omap      = ▹_
    ; fmap      = fmap-▹
    ; fmap-id   = λ {_ n} -> fmap-▹-id {n = n}
    ; fmap-∘    = λ {_ _ _ _ _ n} -> fmap-▹-∘ {n = n}
    ; fmap-cong = fmap-▹-cong
    }
    where
    -- Lifting of ▹
    fmap-▹ : {A B : τ} -> A ⇴ B -> ▹ A ⇴ ▹ B
    fmap-▹ f zero =  λ _ → top.tt
    fmap-▹ f (suc n) = f n
    -- ▹ preserves identities
    fmap-▹-id : ∀ {A : τ} {n : ℕ} {a : ▹ A at n}
             -> (fmap-▹ id at n) a ≡ a
    fmap-▹-id {n = zero} = refl
    fmap-▹-id {n = suc n} = refl
    -- ▹ preserves composition
    fmap-▹-∘ : ∀ {A B C : τ} {g : B ⇴ C} {f : A ⇴ B} {n : ℕ} {a : ▹ A at n}
            -> (fmap-▹ (g ∘ f) at n) a ≡ (fmap-▹ g ∘ fmap-▹ f at n) a
    fmap-▹-∘ {n = zero}  = refl
    fmap-▹-∘ {n = suc n} = refl
    -- ▹ is congruent
    fmap-▹-cong : ∀{A B : τ} {f f′ : A ⇴ B}
            -> ({n : ℕ} {a : A at n}   -> f n a ≡ f′ n a)
            -> ({n : ℕ} {a : ▹ A at n} -> (fmap-▹ f at n) a
                                        ≡ (fmap-▹ f′ at n) a)
    fmap-▹-cong e {zero} = refl
    fmap-▹-cong e {suc n} = e

-- ▹ is a Cartesian functor
F-cart-▹ : CartesianFunctor F-▹ ℝeactive-cart ℝeactive-cart
F-cart-▹ = record
    { u = u-▹
    ; m = m-▹
    ; m-nat₁ = m-nat₁-▹
    ; m-nat₂ = m-nat₂-▹
    ; associative = λ {A}{B}{C}{n}{a} -> assoc-▹ {A}{B}{C}{n}{a}
    ; unital-right = λ {A}{n}{a} -> unit-right-▹ {A}{n}{a}
    ; unital-left = λ {A}{n}{a} -> unit-left-▹ {A}{n}{a}
    }
    where
    open Functor F-▹

    u-▹ : ⊤ ⇴ ▹ ⊤
    u-▹ zero t = top.tt
    u-▹ (suc n) t = top.tt

    m-▹ : ∀(A B : τ) -> ▹ A ⊗ ▹ B ⇴ ▹ (A ⊗ B)
    m-▹ A B zero _ = top.tt
    m-▹ A B (suc n) p = p

    m-nat₁-▹ : ∀{A B C : τ} (f : A ⇴ B)
          -> fmap (f * id) ∘ m-▹ A C ≈ m-▹ B C ∘ fmap f * id
    m-nat₁-▹ f {zero} {a} = refl
    m-nat₁-▹ f {suc n} {a} = refl

    m-nat₂-▹ : ∀{A B C : τ} (f : A ⇴ B)
          -> fmap (id * f) ∘ m-▹ C A ≈ m-▹ C B ∘ id * fmap f
    m-nat₂-▹ f {zero} {a} = refl
    m-nat₂-▹ f {suc n} {a} = refl

    assoc-▹ : ∀{A B C : τ}
           -> m-▹ A (B ⊗ C) ∘ id * m-▹ B C ∘ assoc-right
            ≈ fmap assoc-right ∘ m-▹ (A ⊗ B) C ∘ m-▹ A B * id
    assoc-▹ {A} {B} {C} {zero} {a} = refl
    assoc-▹ {A} {B} {C} {suc n} {(▹A , ▹B) , ▹C} = refl

    unit-right-▹ : ∀{A : τ} ->
        fmap unit-right ∘ m-▹ A ⊤ ∘ (id * u-▹) ≈ unit-right
    unit-right-▹ {A} {zero} {a} = refl
    unit-right-▹ {A} {suc n} {a} = refl

    unit-left-▹ : ∀{A : τ} ->
        fmap unit-left ∘ m-▹ ⊤ A ∘ (u-▹ * id) ≈ unit-left
    unit-left-▹ {A} {zero} {a} = refl
    unit-left-▹ {A} {suc n} {a} = refl

-- ▹ preserves coproducts
sum-▹ : ∀{A B : τ} -> (▹ A ⊕ ▹ B) ⇴ ▹ (A ⊕ B)
sum-▹ zero v = top.tt
sum-▹ (suc n) v = v


{-# OPTIONS --cubical --safe #-}

module Cubical.Structures.Poset where

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Logic
open import Cubical.Foundations.Isomorphism
open import Cubical.Foundations.Equiv        hiding   (_■)
open import Cubical.Foundations.SIP          renaming (SNS-≡ to SNS)
open import Cubical.Core.Primitives
open import Cubical.Foundations.HLevels
open import Cubical.Data.Sigma
open import Cubical.Data.Sigma.Properties

-- We will adopt the convention of denoting the level of the carrier
-- set by ℓ₀ and the level of the relation result by ℓ₁.
private
  variable
    ℓ₀ ℓ₁ : Level

Order : (ℓ₁ : Level) → Type ℓ₀ → Type (ℓ-max ℓ₀ (ℓ-suc ℓ₁))
Order ℓ₁ A = A → A → hProp ℓ₁

order-iso : (M N : Σ (Type ℓ₀) (Order ℓ₁)) →  fst M ≃ fst N → Type (ℓ-max ℓ₀ ℓ₁)
order-iso (A , _⊑₀_) (B , _⊑₁_) (f , _) = (x y : A) → [ x ⊑₀ y ⇔ f x ⊑₁ f y ]

isSetOrder : (ℓ₁ : Level) (A : Type ℓ₀) → isSet (Order ℓ₁ A)
isSetOrder ℓ₁ A = isSetΠ2 λ _ _ → isSetHProp

Order-is-SNS : SNS {ℓ₀} (Order ℓ₁) order-iso
Order-is-SNS {ℓ₁ = ℓ₁} {X = X}  _⊑₀_ _⊑₁_ = f , f-equiv
  where
    f : order-iso (X , _⊑₀_) (X , _⊑₁_) (idEquiv X) → _⊑₀_ ≡ _⊑₁_
    f i = funExt λ x → funExt λ y → ⇔toPath (fst (i x y)) (snd (i x y))

    ⇔-prop : isProp ((x y : X) → [ x ⊑₀ y ⇔ x ⊑₁ y ])
    ⇔-prop = isPropΠ2 λ x y → snd (x ⊑₀ y ⇔ x ⊑₁ y)

    f-equiv : isEquiv f
    f-equiv = record { equiv-proof = λ eq → (g eq , sec eq) , h eq }
      where
        g : (eq : _⊑₀_ ≡ _⊑₁_)
          → (x y : X)
          → ([ x ⊑₀ y ] → [ x ⊑₁ y ]) × ([ x ⊑₁ y ] → [ x ⊑₀ y ])
        g eq x y = subst (λ { _⊑⋆_ → [ x ⊑⋆ y ] }) eq
                 , subst (λ { _⊑⋆_ → [ x ⊑⋆ y ] }) (sym eq)

        sec : section f g
        sec p = isSetOrder _ X _⊑₀_ _⊑₁_ (f (g p)) p

        h : (p : _⊑₀_ ≡ _⊑₁_) → (fib : fiber f p) → (g p , sec p) ≡ fib
        h p (i , _) = ΣProp≡ A-prop B-prop
          where
            A-prop = λ i′ → isOfHLevelSuc 2 (isSetOrder ℓ₁ X) _⊑₀_ _⊑₁_ (f i′) p
            B-prop = ⇔-prop (g p) i

-- We now write down the axioms for a partial order.

isReflexive : {A : Type ℓ₀} → Order ℓ₁ A → hProp (ℓ-max ℓ₀ ℓ₁)
isReflexive {A = X} _⊑_ = ((x : X) → [ x ⊑ x ]) , isPropΠ λ x → snd (x ⊑ x)

isTransitive : {A : Type ℓ₀} → Order ℓ₁ A → hProp (ℓ-max ℓ₀ ℓ₁)
isTransitive {ℓ₀ = ℓ₀} {ℓ₁ = ℓ₁} {A = X} _⊑_ = φ , φ-prop
  where
    φ      : Type (ℓ-max ℓ₀ ℓ₁)
    φ      = ((x y z : X) → [ x ⊑ y ⇒ y ⊑ z ⇒ x ⊑ z ])
    φ-prop : isProp φ
    φ-prop = isPropΠ3 λ x y z → snd (x ⊑ y ⇒ y ⊑ z ⇒ x ⊑ z)

isAntisym : {A : Type ℓ₀} → isSet A → Order ℓ₁ A → hProp (ℓ-max ℓ₀ ℓ₁)
isAntisym {ℓ₀ = ℓ₀} {ℓ₁ = ℓ₁} {A = X} A-set _⊑_ = φ , φ-prop
  where
    φ      : Type (ℓ-max ℓ₀ ℓ₁)
    φ      = ((x y : X) → [ x ⊑ y ] → [ y ⊑ x ] → x ≡ y)
    φ-prop : isProp φ
    φ-prop = isPropΠ3 λ x y z → isPropΠ λ _ → A-set x y

-- The predicate expressing that a given order satisfies the partial order
-- axioms.
satPosetAx : (ℓ₁ : Level) (A : Type ℓ₀) → Order ℓ₁ A → hProp (ℓ-max ℓ₀ ℓ₁)
satPosetAx {ℓ₀ = ℓ₀} ℓ₁ A _⊑_ = φ , φ-prop
  where
    isPartial : isSet A → hProp (ℓ-max ℓ₀ ℓ₁)
    isPartial A-set = isReflexive _⊑_ ⊓ isTransitive _⊑_ ⊓ isAntisym A-set _⊑_

    φ         = Σ[ A-set ∈ isSet A ] [ isPartial A-set ]
    φ-prop    = isOfHLevelΣ 1 isPropIsSet (λ x → snd (isPartial x))

-- The poset structure.
PosetStr : (ℓ₁ : Level) → Type ℓ₀ → Type (ℓ-max ℓ₀ (ℓ-suc ℓ₁))
PosetStr ℓ₁ = add-to-structure (Order ℓ₁) λ A _⊑_ → [ satPosetAx ℓ₁ A _⊑_ ]

PosetStr-set : (ℓ₁ : Level) (A : Type ℓ₀) → isSet (PosetStr ℓ₁ A)
PosetStr-set ℓ₁ A =
  isSetΣ
    (isSetΠ2 λ _ _ → isSetHProp) λ _⊑_ →
      isProp→isSet (snd (satPosetAx ℓ₁ A _⊑_))

Poset : (ℓ₀ ℓ₁ : Level) → Type (ℓ-max (ℓ-suc ℓ₀) (ℓ-suc ℓ₁))
Poset ℓ₀ ℓ₁ = TypeWithStr ℓ₀ (PosetStr ℓ₁)

-- Some projections for syntactic convenience.

-- Carrier set of a poset.
∣_∣ₚ : Poset ℓ₀ ℓ₁ → Type ℓ₀
∣ X , _ ∣ₚ = X

strₚ : (P : Poset ℓ₀ ℓ₁) → PosetStr ℓ₁ ∣ P ∣ₚ
strₚ (_ , s) = s

rel : (P : Poset ℓ₀ ℓ₁) → ∣ P ∣ₚ → ∣ P ∣ₚ → hProp ℓ₁
rel (_ , _⊑_ , _) = _⊑_

syntax rel P x y = x ⊑[ P ] y

⊑[_]-refl : (P : Poset ℓ₀ ℓ₁) → (x : ∣ P ∣ₚ) → [ x ⊑[ P ] x ]
⊑[_]-refl (_ , _ , _ , ⊑-refl , _) = ⊑-refl

⊑[_]-trans : (P : Poset ℓ₀ ℓ₁) (x y z : ∣ P ∣ₚ)
           → [ x ⊑[ P ] y ] → [ y ⊑[ P ] z ] → [ x ⊑[ P ] z ]
⊑[_]-trans (_ , _ , _ , _ , ⊑-trans , _) = ⊑-trans

⊑[_]-antisym : (P : Poset ℓ₀ ℓ₁) (x y : ∣ P ∣ₚ)
             → [ x ⊑[ P ] y ] → [ y ⊑[ P ] x ] → x ≡ y
⊑[_]-antisym (_ , _ , _ , _ , _ , ⊑-antisym) = ⊑-antisym

carrier-is-set : (P : Poset ℓ₀ ℓ₁) → isSet ∣ P ∣ₚ
carrier-is-set (_ , _ , is-set , _) = is-set

module PosetReasoning (P : Poset ℓ₀ ℓ₁) where

  _⊑⟨_⟩_ : (x : ∣ P ∣ₚ) {y z : ∣ P ∣ₚ}
         → [ x ⊑[ P ] y ] → [ y ⊑[ P ] z ] → [ x ⊑[ P ] z ]
  _ ⊑⟨ p ⟩ q = ⊑[ P ]-trans _ _ _ p q

  _■ : (x : ∣ P ∣ₚ) → [ x ⊑[ P ] x ]
  _■ = ⊑[ P ]-refl

  infixr 0 _⊑⟨_⟩_
  infix  1 _■

-- Poset univalence.
RP-iso-prop : (P Q : Σ (Type ℓ₀) (Order ℓ₁))
            → (eqv : fst P ≃ fst Q) → isProp (order-iso P Q eqv)
RP-iso-prop (A , _⊑₀_) (B , _⊑₁_) (f , _) =
  isPropΠ2 λ x y → snd (x ⊑₀ y ⇔ f x ⊑₁ f y)

poset-iso : (P Q : Poset ℓ₀ ℓ₁) → ∣ P ∣ₚ ≃ ∣ Q ∣ₚ → Type (ℓ-max ℓ₀ ℓ₁)
poset-iso {ℓ₁ = ℓ₁} = add-to-iso order-iso (λ A _⊑_ → [ satPosetAx ℓ₁ A _⊑_ ])

-- We collect poset isomorphisms in the following type.
_≃ₚ_ : Poset ℓ₀ ℓ₁ → Poset ℓ₀ ℓ₁ → Type (ℓ-max ℓ₀ ℓ₁)
_≃ₚ_ P Q = Σ[ i ∈ (∣ P ∣ₚ ≃ ∣ Q ∣ₚ) ] poset-iso P Q i

poset-ax-props : (A : Type ℓ₀) (str : Order ℓ₁ A)
                   → isProp [ satPosetAx ℓ₁ A str ]
poset-ax-props {ℓ₁ = ℓ₁} A str = snd (satPosetAx ℓ₁ A str)

poset-is-SNS : SNS {ℓ₀} (PosetStr ℓ₁) poset-iso
poset-is-SNS {ℓ₁ = ℓ₁} =
    SNS-PathP→SNS-≡ _ poset-iso (add-axioms-SNS _ poset-ax-props isSNS-PathP)
  where
    isSNS-PathP : SNS-PathP (Order ℓ₁) order-iso
    isSNS-PathP = SNS-≡→SNS-PathP order-iso Order-is-SNS

poset-is-SNS-PathP : SNS-PathP {ℓ₀} (PosetStr ℓ₁) poset-iso
poset-is-SNS-PathP = SNS-≡→SNS-PathP poset-iso poset-is-SNS

poset-SIP : (A : Type ℓ₀) (B : Type ℓ₀) (eqv : A ≃ B)
            (P : PosetStr ℓ₁ A) (Q : PosetStr ℓ₁ B)
          → poset-iso (A , P) (B , Q) eqv
          → (A , P) ≡ (B , Q)
poset-SIP {ℓ₁ = ℓ₁} A B eqv P Q i = φ (eqv , i)
  where
    φ : (A , P) ≃[ poset-iso ] (B , Q) → (A , P) ≡ (B , Q)
    φ = equivFun (SIP poset-is-SNS-PathP (A , P) (B , Q))

≃ₚ→≡ : (P Q : Poset ℓ₀ ℓ₁) → P ≃ₚ Q → P ≡ Q
≃ₚ→≡ (A , A-pos) (B , B-pos) (eqv , i) = poset-SIP A B eqv A-pos B-pos i


open import Everything

module Test.Test5
  {𝔵} {𝔛 : Ø 𝔵}
  {𝔞} {𝔒₁ : 𝔛 → Ø 𝔞}
  {𝔟} {𝔒₂ : 𝔛 → Ø 𝔟}
  {ℓ}
  {ℓ̇} (_↦_ : ∀ {x} → 𝔒₂ x → 𝔒₂ x → Ø ℓ̇)
  ⦃ _ : [ExtensibleType] _↦_ ⦄
  ⦃ _ : Smap!.class (Arrow 𝔒₁ 𝔒₂) (Extension 𝔒₂) ⦄
  ⦃ _ : Surjextensionality!.class (Arrow 𝔒₁ 𝔒₂) (Pointwise _↦_) (Extension 𝔒₂) (Pointwise _↦_) ⦄
  -- ⦃ _ : [𝓢urjectivity] (Arrow 𝔒₁ 𝔒₂) (Extension $ ArrowExtensionṖroperty ℓ 𝔒₁ 𝔒₂ _↦_) ⦄
  where
  test[∙] : ∀ {x y} → ArrowExtensionṖroperty ℓ 𝔒₁ 𝔒₂ _↦_ x → Arrow 𝔒₁ 𝔒₂ x y → ArrowExtensionṖroperty ℓ 𝔒₁ 𝔒₂ _↦_ y
  test[∙] P f = f ◃ P


module _ where

open import Agda.Builtin.Equality
open import Agda.Builtin.Nat

module Vars (A : Set) where
  variable
    x : A

data It {A : Set} : A → Set where
  it : ∀ x → It x

module Fixed where
  open Vars Nat
  ret : It x
  ret {x = x} = it x

module Param (A : Set) where
  open Vars A
  ret : It x
  ret {x = x} = it x

open Vars Nat

check : Param.ret Nat ≡ Fixed.ret {x = x}
check = refl

-- Check that you can let open as long as you don't use the variables
foo : (A : Set) (let open Vars A) (x : A) → x ≡ x
foo A x = refl