------------------------------------------------------------------------
-- Recognisers form a Kleene algebra
------------------------------------------------------------------------

module TotalRecognisers.LeftRecursion.KleeneAlgebra (Tok : Set) where

open import Algebra
import Algebra.Properties.BooleanAlgebra
open import Codata.Musical.Notation
open import Data.Bool hiding (_∧_; _≤_)
import Data.Bool.Properties as Bool
private
  module BoolCS = CommutativeSemiring Bool.∨-∧-commutativeSemiring
  module BoolBA = Algebra.Properties.BooleanAlgebra
                    Bool.∨-∧-booleanAlgebra
open import Function.Base
open import Function.Equality using (_⟨$⟩_)
open import Function.Equivalence as Eq using (_⇔_; equivalence)
open import Data.List
open import Data.List.Properties
private
  module ListMonoid {A : Set} = Monoid (++-monoid A)
open import Data.Nat using (ℕ; zero; suc)
open import Data.Product as Prod
open import Relation.Binary.HeterogeneousEquality using (_≅_; refl)
open import Relation.Binary.PropositionalEquality as P
  using (_≡_; refl; _≗_)
open import Relation.Nullary

import TotalRecognisers.LeftRecursion
open TotalRecognisers.LeftRecursion Tok hiding (left-zero)
import TotalRecognisers.LeftRecursion.Lib
open TotalRecognisers.LeftRecursion.Lib Tok
open ⊙ using (_⊙′_)
open KleeneStar₂

------------------------------------------------------------------------
-- The relation _≤_ is a partial order with respect to _≈_

module PartialOrder where

  reflexive : ∀ {n} {p : P n} → p ≤ p
  reflexive = id

  trans : ∀ {n₁ n₂ n₃} {p₁ : P n₁} {p₂ : P n₂} {p₃ : P n₃} →
          p₁ ≤ p₂ → p₂ ≤ p₃ → p₁ ≤ p₃
  trans p₁≤p₂ p₂≤p₃ = p₂≤p₃ ∘ p₁≤p₂

  antisym : ∀ {n₁ n₂} {p₁ : P n₁} {p₂ : P n₂} →
            p₁ ≤ p₂ → p₂ ≤ p₁ → p₁ ≈ p₂
  antisym p₁≤p₂ p₂≤p₁ = equivalence p₁≤p₂ p₂≤p₁

------------------------------------------------------------------------
-- The relation _≈_ is an equality, i.e. a congruential equivalence
-- relation

module Equivalence where

  reflexive : ∀ {n} {p : P n} → p ≈ p
  reflexive = Eq.id

  sym : ∀ {n₁ n₂} {p₁ : P n₁} {p₂ : P n₂} → p₁ ≈ p₂ → p₂ ≈ p₁
  sym p₁≈p₂ = Eq.sym p₁≈p₂

  trans : ∀ {n₁ n₂ n₃} {p₁ : P n₁} {p₂ : P n₂} {p₃ : P n₃} →
          p₁ ≈ p₂ → p₂ ≈ p₃ → p₁ ≈ p₃
  trans p₁≈p₂ p₂≈p₃ = Eq._∘_ p₂≈p₃ p₁≈p₂

♭♯-cong : ∀ {n₁ n₂} b₁ b₂ {p₁ : P n₁} {p₂ : P n₂} →
          p₁ ≈ p₂ → ♭? (♯? {b₁} p₁) ≈ ♭? (♯? {b₂} p₂)
♭♯-cong b₁ b₂ {p₁} {p₂} rewrite ♭?♯? b₁ {p = p₁} | ♭?♯? b₂ {p = p₂} = id

fail-cong : fail ≈ fail
fail-cong = Equivalence.reflexive

empty-cong : empty ≈ empty
empty-cong = Equivalence.reflexive

sat-cong : {f₁ f₂ : Tok → Bool} → f₁ ≗ f₂ → sat f₁ ≈ sat f₂
sat-cong f₁≗f₂ = equivalence (helper f₁≗f₂) (helper (P.sym ∘ f₁≗f₂))
  where
  helper : {f₁ f₂ : Tok → Bool} → f₁ ≗ f₂ → sat f₁ ≤ sat f₂
  helper f₁≗f₂ (sat ok) = sat (P.subst T (f₁≗f₂ _) ok)

∣-cong : ∀ {n₁ n₂ n₃ n₄}
           {p₁ : P n₁} {p₂ : P n₂} {p₃ : P n₃} {p₄ : P n₄} →
         p₁ ≈′ p₃ → p₂ ≈′ p₄ → p₁ ∣ p₂ ≈′ p₃ ∣ p₄
∣-cong (refl ∷ rest₁) (refl ∷ rest₂) =
  refl ∷ λ t → ♯ ∣-cong (♭ (rest₁ t)) (♭ (rest₂ t))

·-cong : ∀ {n₁ n₂ n₃ n₄}
           {p₁ : ∞⟨ n₂ ⟩P n₁} {p₂ : ∞⟨ n₁ ⟩P n₂}
           {p₃ : ∞⟨ n₄ ⟩P n₃} {p₄ : ∞⟨ n₃ ⟩P n₄} →
         ♭? p₁ ≈ ♭? p₃ → ♭? p₂ ≈ ♭? p₄ → p₁ · p₂ ≈ p₃ · p₄
·-cong p₁≈p₃ p₂≈p₄ =
  Eq.Equivalence.from ≈⇔≤≥ ⟨$⟩
    Prod.zip helper helper
             (Eq.Equivalence.to ≈⇔≤≥ ⟨$⟩ p₁≈p₃)
             (Eq.Equivalence.to ≈⇔≤≥ ⟨$⟩ p₂≈p₄)
  where
  helper : ∀ {n₁ n₂ n₃ n₄}
             {p₁ : ∞⟨ n₂ ⟩P n₁} {p₂ : ∞⟨ n₁ ⟩P n₂}
             {p₃ : ∞⟨ n₄ ⟩P n₃} {p₄ : ∞⟨ n₃ ⟩P n₄} →
           ♭? p₁ ≤ ♭? p₃ → ♭? p₂ ≤ ♭? p₄ → p₁ · p₂ ≤ p₃ · p₄
  helper ₁≤₃ ₂≤₄ (∈p₁ · ∈p₂) = ₁≤₃ ∈p₁ · ₂≤₄ ∈p₂

⊙-cong : ∀ {n₁ n₂ n₃ n₄}
           {p₁ : P n₁} {p₂ : P n₂} {p₃ : P n₃} {p₄ : P n₄} →
         p₁ ≈ p₃ → p₂ ≈ p₄ → p₁ ⊙ p₂ ≈ p₃ ⊙ p₄
⊙-cong {n₁} {n₂} {n₃} {n₄} ₁≈₃ ₂≈₄ =
  ·-cong (♭♯-cong n₂ n₄ ₁≈₃) (♭♯-cong n₁ n₃ ₂≈₄)

nonempty-cong : ∀ {n₁ n₂} {p₁ : P n₁} {p₂ : P n₂} →
                p₁ ≈′ p₂ → nonempty p₁ ≈′ nonempty p₂
nonempty-cong (_ ∷ rest) = refl ∷ rest

cast-cong : ∀ {n₁ n₂ n₁′ n₂′}
              {p₁ : P n₁} {p₂ : P n₂}
              {eq₁ : n₁ ≡ n₁′} {eq₂ : n₂ ≡ n₂′} →
            p₁ ≈′ p₂ → cast eq₁ p₁ ≈′ cast eq₂ p₂
cast-cong {eq₁ = refl} {refl} (init ∷ rest) = init ∷ rest

⋆-cong : ∀ {n₁ n₂} {p₁ : P n₁} {p₂ : P n₂} →
         p₁ ≈ p₂ → p₁ ⋆ ≈ p₂ ⋆
⋆-cong p₁≈p₂ = Eq.Equivalence.from ≈⇔≤≥ ⟨$⟩
                 Prod.map helper helper
                   (Eq.Equivalence.to ≈⇔≤≥ ⟨$⟩ p₁≈p₂)
  where
  helper : ∀ {n₁ n₂} {p₁ : P n₁} {p₂ : P n₂} →
           p₁ ≤ p₂ → p₁ ⋆ ≤ p₂ ⋆
  helper p₁≤p₂ (∣-left  empty)                 = ∣-left empty
  helper p₁≤p₂ (∣-right (nonempty ∈p₁ · ∈p₁⋆)) =
    ∣-right {p₁ = empty} (nonempty (p₁≤p₂ ∈p₁) · helper p₁≤p₂ ∈p₁⋆)

^-cong : ∀ {n₁ n₂ i₁ i₂} {p₁ : P n₁} {p₂ : P n₂} →
         p₁ ≈ p₂ → i₁ ≡ i₂ → p₁ ^ i₁ ≈ p₂ ^ i₂
^-cong {i₁ = i} p₁≈p₂ refl =
  Eq.Equivalence.from ≈⇔≤≥ ⟨$⟩
    Prod.map (helper i) (helper i)
             (Eq.Equivalence.to ≈⇔≤≥ ⟨$⟩ p₁≈p₂)
  where
  helper : ∀ {n₁ n₂} {p₁ : P n₁} {p₂ : P n₂} i →
           p₁ ≤ p₂ → p₁ ^ i ≤ p₂ ^ i
  helper           zero    p₁≤p₂ empty   = empty
  helper {n₁} {n₂} (suc i) p₁≤p₂ ∈p₁⊙p₁ⁱ
    with ⊙.sound ⟨ n₁ ^ i ⟩-nullable ∈p₁⊙p₁ⁱ
  ... | ∈p₁ ⊙′ ∈p₁ⁱ = ⊙.complete (p₁≤p₂ ∈p₁) (helper i p₁≤p₂ ∈p₁ⁱ)

------------------------------------------------------------------------
-- A variant of _≤_

infix 4 _≲_

-- If _∣_ is viewed as the join operation of a join-semilattice, then
-- the following definition of order is natural.

_≲_ : ∀ {n₁ n₂} → P n₁ → P n₂ → Set
p₁ ≲ p₂ = p₁ ∣ p₂ ≈ p₂

-- The order above coincides with _≤_.

≤⇔≲ : ∀ {n₁ n₂} (p₁ : P n₁) (p₂ : P n₂) → p₁ ≤ p₂ ⇔ p₁ ≲ p₂
≤⇔≲ {n₁} p₁ p₂ =
  equivalence
    (λ (p₁≤p₂ : p₁ ≤ p₂) {_} →
       equivalence (helper p₁≤p₂) (∣-right {n₁ = n₁}))
    (λ (p₁≲p₂ : p₁ ≲ p₂) s∈p₁ → Eq.Equivalence.to p₁≲p₂ ⟨$⟩ ∣-left s∈p₁)
  where
  helper : p₁ ≤ p₂ → p₁ ∣ p₂ ≤ p₂
  helper p₁≤p₂ (∣-left  s∈p₁) = p₁≤p₂ s∈p₁
  helper p₁≤p₂ (∣-right s∈p₂) = s∈p₂

------------------------------------------------------------------------
-- Recognisers form a *-continuous Kleene algebra

-- The definition of *-continuous Kleene algebras used here is the one
-- given by Kozen in "On Kleene Algebras and Closed Semirings", except
-- for the presence of the recogniser indices. Kozen used the order
-- _≲_ in his definition, but as shown above this order is equivalent
-- to _≤_.

-- Additive idempotent commutative monoid. (One of the identity lemmas
-- could be omitted.)

∣-commutative : ∀ {n₁ n₂} (p₁ : P n₁) (p₂ : P n₂) → p₁ ∣ p₂ ≈′ p₂ ∣ p₁
∣-commutative {n₁} {n₂} p₁ p₂ =
  BoolCS.+-comm n₁ n₂ ∷ λ t → ♯ ∣-commutative (D t p₁) (D t p₂)

fail-left-identity : ∀ {n} (p : P n) → fail ∣ p ≈′ p
fail-left-identity p = refl ∷ λ t → ♯ fail-left-identity (D t p)

fail-right-identity : ∀ {n} (p : P n) → p ∣ fail ≈′ p
fail-right-identity {n} p =
  proj₂ BoolCS.+-identity n ∷ λ t → ♯ fail-right-identity (D t p)

∣-associative : ∀ {n₁ n₂ n₃} (p₁ : P n₁) (p₂ : P n₂) (p₃ : P n₃) →
                p₁ ∣ (p₂ ∣ p₃) ≈′ (p₁ ∣ p₂) ∣ p₃
∣-associative {n₁} {n₂} {n₃} p₁ p₂ p₃ =
  P.sym (BoolCS.+-assoc n₁ n₂ n₃) ∷ λ t →
    ♯ ∣-associative (D t p₁) (D t p₂) (D t p₃)

∣-idempotent : ∀ {n} (p : P n) → p ∣ p ≈′ p
∣-idempotent {n} p =
  BoolBA.∨-idempotent n ∷ λ t → ♯ ∣-idempotent (D t p)

-- Multiplicative monoid.

empty-left-identity : ∀ {n} (p : P n) → empty ⊙ p ≈ p
empty-left-identity {n} p =
  equivalence helper (λ s∈p → ⊙.complete empty s∈p)
  where
  helper : empty ⊙ p ≤ p
  helper ∈empty⊙p with ⊙.sound n ∈empty⊙p
  ... | empty ⊙′ s∈p = s∈p

empty-right-identity : ∀ {n} (p : P n) → p ⊙ empty ≈ p
empty-right-identity {n} p =
  equivalence
    helper
    (λ s∈p → cast∈ (proj₂ ListMonoid.identity _) refl
                   (⊙.complete s∈p empty))
  where
  helper : ∀ {s} → s ∈ p ⊙ empty → s ∈ p
  helper ∈p⊙empty with ⊙.sound true ∈p⊙empty
  helper ∈p⊙empty | ∈p ⊙′ empty =
    cast∈ (P.sym (proj₂ ListMonoid.identity _)) refl ∈p

·-associative : ∀ {n₁ n₂ n₃} (p₁ : P n₁) (p₂ : P n₂) (p₃ : P n₃) →
                p₁ ⊙ (p₂ ⊙ p₃) ≈ (p₁ ⊙ p₂) ⊙ p₃
·-associative {n₁} {n₂} {n₃} p₁ p₂ p₃ = equivalence helper₁ helper₂
  where
  helper₁ : p₁ ⊙ (p₂ ⊙ p₃) ≤ (p₁ ⊙ p₂) ⊙ p₃
  helper₁ ∈⊙⊙ with ⊙.sound (n₂ ∧ n₃) ∈⊙⊙
  ... | _⊙′_ {s₁ = s₁} ∈p₁ ∈⊙ with ⊙.sound n₃ ∈⊙
  ...   | ∈p₂ ⊙′ ∈p₃ =
    cast∈ (ListMonoid.assoc s₁ _ _) refl $
      ⊙.complete (⊙.complete ∈p₁ ∈p₂) ∈p₃

  helper₂ : (p₁ ⊙ p₂) ⊙ p₃ ≤ p₁ ⊙ (p₂ ⊙ p₃)
  helper₂ ∈⊙⊙ with ⊙.sound n₃ ∈⊙⊙
  ... | ∈⊙ ⊙′ ∈p₃ with ⊙.sound n₂ ∈⊙
  ...   | _⊙′_ {s₁ = s₁} ∈p₁ ∈p₂ =
    cast∈ (P.sym $ ListMonoid.assoc s₁ _ _) refl $
      ⊙.complete ∈p₁ (⊙.complete ∈p₂ ∈p₃)

-- Distributivity.

left-distributive :
  ∀ {n₁ n₂ n₃} (p₁ : P n₁) (p₂ : P n₂) (p₃ : P n₃) →
  p₁ ⊙ (p₂ ∣ p₃) ≈ p₁ ⊙ p₂ ∣ p₁ ⊙ p₃
left-distributive {n₁} {n₂} {n₃} p₁ p₂ p₃ = equivalence helper₁ helper₂
  where
  helper₁ : p₁ ⊙ (p₂ ∣ p₃) ≤ p₁ ⊙ p₂ ∣ p₁ ⊙ p₃
  helper₁ ∈⊙∣ with ⊙.sound (n₂ ∨ n₃) ∈⊙∣
  ... | ∈p₁ ⊙′ ∣-left  ∈p₂ = ∣-left $ ⊙.complete ∈p₁ ∈p₂
  ... | ∈p₁ ⊙′ ∣-right ∈p₃ = ∣-right {n₁ = n₁ ∧ n₂} $ ⊙.complete ∈p₁ ∈p₃

  helper₂ : p₁ ⊙ p₂ ∣ p₁ ⊙ p₃ ≤ p₁ ⊙ (p₂ ∣ p₃)
  helper₂ (∣-left ∈⊙) with ⊙.sound n₂ ∈⊙
  ... | ∈p₁ ⊙′ ∈p₂ = ⊙.complete ∈p₁ (∣-left ∈p₂)
  helper₂ (∣-right ∈⊙) with ⊙.sound n₃ ∈⊙
  ... | ∈p₁ ⊙′ ∈p₃ = ⊙.complete ∈p₁ (∣-right {n₁ = n₂} ∈p₃)

right-distributive :
  ∀ {n₁ n₂ n₃} (p₁ : P n₁) (p₂ : P n₂) (p₃ : P n₃) →
  (p₁ ∣ p₂) ⊙ p₃ ≈ p₁ ⊙ p₃ ∣ p₂ ⊙ p₃
right-distributive {n₁} {n₂} {n₃} p₁ p₂ p₃ = equivalence helper₁ helper₂
  where
  helper₁ : (p₁ ∣ p₂) ⊙ p₃ ≤ p₁ ⊙ p₃ ∣ p₂ ⊙ p₃
  helper₁ ∈∣⊙ with ⊙.sound n₃ ∈∣⊙
  ... | ∣-left  ∈p₁ ⊙′ ∈p₃ = ∣-left $ ⊙.complete ∈p₁ ∈p₃
  ... | ∣-right ∈p₂ ⊙′ ∈p₃ = ∣-right {n₁ = n₁ ∧ n₃} $ ⊙.complete ∈p₂ ∈p₃

  helper₂ : p₁ ⊙ p₃ ∣ p₂ ⊙ p₃ ≤ (p₁ ∣ p₂) ⊙ p₃
  helper₂ (∣-left ∈⊙) with ⊙.sound n₃ ∈⊙
  ... | ∈p₁ ⊙′ ∈p₃ = ⊙.complete (∣-left ∈p₁) ∈p₃
  helper₂ (∣-right ∈⊙) with ⊙.sound n₃ ∈⊙
  ... | ∈p₂ ⊙′ ∈p₃ = ⊙.complete (∣-right {n₁ = n₁} ∈p₂) ∈p₃

-- Zero.

left-zero : ∀ {n} (p : P n) → fail ⊙ p ≈ fail
left-zero {n} p = equivalence helper (λ ())
  where
  helper : fail ⊙ p ≤ fail
  helper ∈fail⊙ with ⊙.sound n ∈fail⊙
  ... | () ⊙′ _

right-zero : ∀ {n} (p : P n) → p ⊙ fail ≈ fail
right-zero {n} p = equivalence helper (λ ())
  where
  helper : p ⊙ fail ≤ fail
  helper ∈⊙fail with ⊙.sound false ∈⊙fail
  ... | _ ⊙′ ()

-- *-continuity.

*-continuity-upper-bound :
  ∀ {n₁ n₂ n₃} (p₁ : P n₁) (p₂ : P n₂) (p₃ : P n₃) →
  ∀ i → p₁ ⊙ p₂ ^ i ⊙ p₃ ≤ p₁ ⊙ p₂ ⋆ ⊙ p₃
*-continuity-upper-bound {n₁} {n₂} {n₃} _ _ _ i ∈⊙ⁱ⊙
  with ⊙.sound n₃ ∈⊙ⁱ⊙
... | ∈⊙ⁱ ⊙′ ∈p₃ with ⊙.sound ⟨ n₂ ^ i ⟩-nullable ∈⊙ⁱ
...   | ∈p₁ ⊙′ ∈p₂ⁱ = ⊙.complete (⊙.complete ∈p₁ (^≤⋆ i ∈p₂ⁱ)) ∈p₃

*-continuity-least-upper-bound :
  ∀ {n₁ n₂ n₃ n} (p₁ : P n₁) (p₂ : P n₂) (p₃ : P n₃) (p : P n) →
  (∀ i → p₁ ⊙ p₂ ^ i ⊙ p₃ ≤ p) → p₁ ⊙ p₂ ⋆ ⊙ p₃ ≤ p
*-continuity-least-upper-bound {n₁} {n₂} {n₃} {n} p₁ p₂ p₃ p ub =
  helper ∘ _⟨$⟩_ (Eq.Equivalence.from $ ·-associative p₁ (p₂ ⋆) p₃)
  where
  helper : p₁ ⊙ (p₂ ⋆ ⊙ p₃) ≤ p
  helper ∈⊙⋆⊙ with ⊙.sound (true ∧ n₃) ∈⊙⋆⊙
  ... | _⊙′_ {s₁ = s₁} ∈p₁ ∈⋆⊙ with ⊙.sound n₃ ∈⋆⊙
  ...   | ∈p₂⋆ ⊙′ ∈p₃ with ⋆≤^ ∈p₂⋆
  ...     | (i , ∈p₂ⁱ) =
    cast∈ (ListMonoid.assoc s₁ _ _) refl $
      ub i $ ⊙.complete (⊙.complete ∈p₁ ∈p₂ⁱ) ∈p₃


-- A variant of code reported by Andreas Abel (who suggested that this
-- way to trigger the bug might have been due to NAD).

{-# OPTIONS --guardedness --sized-types #-}

open import Agda.Builtin.Sigma
open import Agda.Builtin.Size

data ⊥ : Set where

record Delay (A : Set) : Set where
  coinductive
  constructor ♯
  field ♭   : Σ A λ _ → ⊥ → Delay A
  -- Recursive in order to please the termination checker.

open Delay

data D : Size → Set where
  inn : ∀ i → Delay (D i) → D (↑ i)

iter : ∀{i} → D i → ⊥
iter (inn i t) = iter (fst (♭ t))

-- Should be rejected by the termination checker.

bla : Delay (D ∞)
♭ bla = inn ∞ bla , λ()

false : ⊥
false = iter (fst (♭ bla))


{-# OPTIONS --allow-unsolved-metas #-}

data U : ∀ t → Set
data T t : Set


module Issue4954.M (_ : Set₁) where


module Issue4435-2 where

record ⊤ : Set where

data Foo (a : Set) : Set where
Bar : {a : Set} → Foo a → Set

-- Here, the error message does NOT include
-- "Perhaps you meant to write 'data Foo a where'"
-- because Foo is defined above (rather than declared - note the "where"
-- compared to Issue4435-1.agda).
data Foo a : Set where
  c1 : Foo a
  c2 : (x : Foo a) (y : Bar x → Foo a) → Foo a

Bar c1 = ⊤
Bar (c2 a b) = (x : Bar a) → Bar (b x)


------------------------------------------------------------------------
-- The Agda standard library
--
-- Pretty Printing
-- This module is based on Jean-Philippe Bernardy's functional pearl
-- "A Pretty But Not Greedy Printer"
------------------------------------------------------------------------

{-# OPTIONS --with-K #-}

open import Data.Nat.Base using (ℕ)

module Text.Pretty (width : ℕ) where

import Level
open import Data.Char.Base     using (Char)
open import Data.List.Base
  using (List; _∷_; []; [_]; uncons; _++_; map; filter)
open import Data.List.NonEmpty as List⁺ using (foldr₁)
open import Data.Maybe.Base    using (maybe′)
open import Data.Product       using (uncurry)
open import Data.String.Base   using (String; fromList; replicate)
open import Function.Base

open import Category.Monad using (RawMonad)
import Data.List.Categorical as Cat
open RawMonad (Cat.monad {Level.zero})

import Data.Nat.Properties as ℕₚ
open import Data.List.Extrema.Core ℕₚ.≤-totalOrder using (⊓ᴸ)

------------------------------------------------------------------------
-- Internal representation of documents and rendering function

import Text.Pretty.Core as Core

Doc = List Core.Block

render : Doc → String
render = Core.render
       ∘ maybe′ (foldr₁ (⊓ᴸ Core.Block.height) ∘′ uncurry List⁺._∷_) Core.empty
       ∘ uncons

------------------------------------------------------------------------
-- Basic building blocks

fail : Doc
fail = []

text : String → Doc
text = filter (Core.valid width) ∘ pure ∘ Core.text

empty : Doc
empty = text ""

char : Char → Doc
char c = text (fromList (c ∷ []))

spaces : ℕ → Doc
spaces n = text (replicate n ' ')

semi colon comma space dot : Doc
semi = char ';'; colon = char ':'
comma = char ','; space = char ' '; dot = char '.'

backslash forwardslash equal : Doc
backslash = char '\\'; forwardslash = char '/'; equal = char '='

squote dquote : Doc
squote = char '\''; dquote = char '"'

lparen rparen langle rangle : Doc
lparen = char '('; rparen = char ')'
langle = char '<'; rangle = char '>'

lbrace rbrace llbrace rrbrace : Doc
lbrace = char '{'; rbrace = char '}'
llbrace = char '⦃'; rrbrace = char '⦄'

lbracket rbracket llbracket rrbracket : Doc
lbracket = char '['; rbracket = char ']'
llbracket = char '⟦'; rrbracket = char '⟧'

------------------------------------------------------------------------
-- Combining two documents

infixr 5 _<>_
_<>_ : Doc → Doc → Doc
xs <> ys = filter (Core.valid width) (Core._<>_ <$> xs ⊛ ys)

flush : Doc → Doc
flush = map Core.flush

infixr 5 _<+>_
_<+>_ : Doc → Doc → Doc
x <+> y = x <> space <> y

infixr 5 _$$_
_$$_ : Doc → Doc → Doc
x $$ y = flush x <> y

infixr 4 _<|>_
_<|>_ : Doc → Doc → Doc
x <|> y = x ++ y

------------------------------------------------------------------------
-- Combining lists of documents

foldDoc : (Doc → Doc → Doc) → List Doc → Doc
foldDoc _ []       = empty
foldDoc _ (x ∷ []) = x
foldDoc f (x ∷ xs) = f x (foldDoc f xs)

hsep vcat : List Doc → Doc
hsep = foldDoc _<+>_
vcat = foldDoc _$$_

sep : List Doc → Doc
sep [] = empty
sep xs = hsep xs <|> vcat xs

------------------------------------------------------------------------
-- Defined combinators

parens : Doc → Doc
parens d = lparen <> d <> rparen

commaSep : List Doc → Doc
commaSep = foldDoc (λ d e → d <> comma <+> e)

newline : Doc
newline = flush empty


{-# OPTIONS --universe-polymorphism --allow-unsolved-metas --no-termination-check #-}

module Issue202 where

Foo : ∀ {A} → A → Set
Foo x = Foo x

-- Previously resulted in the following (cryptic) error:
-- Bug.agda:6,13-14
-- _5 !=< _5
-- when checking that the expression x has type _5


module Effect where

open import Data.List
open import Data.List.All
open import Data.List.Any
open import Level
open import Relation.Binary.PropositionalEquality hiding ([_])
open import Function
open import Category.Monad
open import Data.Product
open import EffectUtil
open import Membership-equality hiding (_⊆_; set)

Effect : ∀ f → Set (suc f)
Effect f = (result : Set f) (i : Set f) (o : result → Set f) → Set f

record EFFECT (f : Level) : Set (suc f) where
  constructor mkEff
  field S : Set f
        E : Effect f

updateResTy : ∀ {f A E i o} → (val : A) →
              (es : List (EFFECT f)) →
              (prf : (mkEff i E) ∈ es) →
              (eff : E A i o) →
              List (EFFECT f)
updateResTy {o = o} val (mkEff i e ∷ es) (here px) eff = mkEff (o val) e ∷ es
updateResTy val (e ∷ es) (there prf) eff = e ∷ updateResTy val es prf eff

updateWith : ∀ {f ys} (ys' : List (EFFECT f)) → (xs : List (EFFECT f)) →
             (ys ⊆ xs) → List (EFFECT f)
updateWith [] xs inc = xs
updateWith (y' ∷ ys') xs [] = xs
updateWith (y' ∷ ys') (_ ∷ xs) (keep inc) = y' ∷ updateWith ys' xs inc
updateWith (y' ∷ ys') (x ∷ xs) (skip inc) = x ∷ updateWith (y' ∷ ys') xs inc

Handler : ∀ {f} → (Set f → Set f) → Effect f → Set (suc f)
Handler M e = ∀ {A a o res} → (r : res) → (eff : e A res o) →
              (k : ((x : A) → o x → M a)) → M a

-- @ A  The return type of the result
-- @ es The list of allowed side-effects
-- @ ce The function to compute a new list of allowed side-effects
data EffM {f : Level} (m : Set f → Set f) : (A : Set f) →
             (es : List (EFFECT f)) →
             (ce : A → List (EFFECT f)) → Set (suc f) where
  return : ∀ {A ce} (val : A) → EffM m A (ce val) ce
  _>>=_  : ∀ {A B es ce₁ ce₂} → EffM m A es ce₁ → (∀ x → EffM m B (ce₁ x) ce₂) → EffM m B es ce₂
  effect : ∀ {A E i es o} (prf : (mkEff i E) ∈ es) →
             (eff : E A i o) →
             EffM m A es (λ v → updateResTy v es prf eff)
  -- use to invoke sub-programs that use some or all of the available effects
  lift   : ∀ {A ys ys' xs} → (inc : ys ⊆ xs) →
           EffM m A ys ys' →
           EffM m A xs (λ v → updateWith (ys' v) xs inc)
  new : ∀ {A es} →
    (e : EFFECT f) →
    (val : EFFECT.S e) →
    Handler m (EFFECT.E e) →
    EffM {f} m A (e ∷ es) (λ v → e ∷ es) →
    EffM m A es (λ v → es)

pure : ∀ {l m A es} → A → EffM {l} m A es (λ v → es)
pure = return

_<*>_ : ∀ {l m A B es} → EffM {l} m (A → B) es (λ v → es) →
                    EffM {l} m A es (λ v → es) →
                    EffM {l} m B es (λ v → es)
_<*>_ prog v = prog >>= λ fn →
               v >>= λ arg →
               pure (fn arg)

_<$>_ : ∀ {l m A B es} → (f : A → B) → EffM {l} m A es (λ v → es) → EffM {l} m B es (λ v → es)
_<$>_ f m = pure f <*> m

data Env {f : Level} : (m : Set f → Set f) → List (EFFECT f) → Set (suc f) where
  [] : ∀ {m} → Env m []
  _∷_ : ∀ {m eff es a} → (el : Handler m eff × a) → Env m es → Env m (mkEff a eff ∷ es)

execEff : ∀ {f m A es E i} {o : A → Set f} {B} →
  Env {f} m es →
  (prf : (mkEff i E) ∈ es) →
  (eff : E A i o) →
  ((v : A) → Env {f} m (updateResTy v es prf eff) → m B) → m B
execEff {m = m} {A = A} {o = o} {B = B} ((handle , val) ∷ env) (here refl) eff k = handle val eff cont
  where
    cont : (v : A) → o v → m B
    cont v res = k v ((handle , res) ∷ env)
execEff (e ∷ env) (there prf) eff k = execEff env prf eff λ v → λ env' → k v (e ∷ env')

dropEnv : ∀ {f m ys xs} → Env {f} m ys → xs ⊆ ys → Env m xs
dropEnv [] [] = []
dropEnv (el ∷ env) [] = []
dropEnv (el ∷ env) (keep sub) = el ∷ (dropEnv env sub)
dropEnv (el ∷ env) (skip sub) = dropEnv env sub

rebuildEnv : ∀ {f m ys' ys xs} → Env {f} m ys' → (prf : ys ⊆ xs) →
             Env m xs → Env m (updateWith ys' xs prf)
rebuildEnv [] [] env = env
rebuildEnv (_ ∷ _) [] env = env
rebuildEnv [] (keep prf) env = env
rebuildEnv (el ∷ els) (keep prf) (_ ∷ env) = el ∷ rebuildEnv els prf env
rebuildEnv [] (skip prf) env = env
rebuildEnv (el ∷ els) (skip prf) (en ∷ env) = en ∷ rebuildEnv (el ∷ els) prf env

eff : ∀ {f m es A B ce} → Env {f} m es → EffM m A es ce → ((v : A) → Env m (ce v) → m B) → m B
eff env (return val) k = k val env
eff env (effM >>= c) k = eff env effM λ p' → λ env' → eff env' ((c p')) k
eff env (effect prf effP) k = execEff env prf effP k
eff env (lift inc effM) k = eff env' effM λ p' → λ envk → k p' (rebuildEnv envk inc env)
  where
    env' = dropEnv env inc
eff {f} {m} {es} {A} {B} env (new e val handler effM) k = eff ((handler , val) ∷ env) effM cont
  where
    cont : (v : A) → Env {f} m (e ∷ es) → m B
    cont v (val ∷ envk) = k v envk

run : ∀ {f a xs xs'} → ∀ m → (mon : RawMonad m) → (prog : EffM {f} m a xs xs') → Env m xs → m a
run m mon prog env = eff env prog λ r → λ env' → RawMonad.return mon r


module _ where

open import Agda.Builtin.List
open import Agda.Builtin.Reflection

macro

  easy : Term → TC _
  easy t =
    bindTC (freshName "A") λ A →
    bindTC (declarePostulate (arg (arg-info visible relevant) A)
                             (agda-sort (lit 0))) λ _ →
    unify (def A []) t

B : Set
B = {!easy!}

-- WAS:
-- Parse error
-- ;<ERROR>
-- Example.A...

-- SHOULD: complain that A is not in scope


module GUIgeneric.GUIDefinitions where

open import GUIgeneric.Prelude

open import Relation.Binary.PropositionalEquality.TrustMe using (trustMe)

open import Relation.Nullary

data _⊎Comp_ {a b} (A : Set a) (B : Set b) : Set (a ⊔Level b) where
  button : (x : A) → A ⊎Comp B
  txtbox : (y : B) → A ⊎Comp B

data Direction : Set where
  left right : Direction

data Comp : Set where
  frame atomicComp : Comp

SubCompsIndex : Comp → Set
SubCompsIndex frame = ⊤
SubCompsIndex atomicComp = ⊥

data isSubComp : (c c' : Comp) → Set where
 buttonFrame  :  isSubComp  atomicComp frame

subComp : (c : Comp){c' : Comp}
         (is : isSubComp c' c) → Comp
subComp  .frame  {cButton}  buttonFrame  =  cButton

createParameters : Comp → Set
createParameters atomicComp = String ⊎Comp String
createParameters _ = ⊤

data IsOptimized : Set where
  optimized notOptimzed : IsOptimized

data CompEls (c : Comp) :  Set where
 createC  :  createParameters c → CompEls c
 add      :  {c' : Comp}(c'c : isSubComp c' c)
             (e' : CompEls c')(e : CompEls c)(isOpt : IsOptimized)
            → CompEls c

data _<c_  : {c c' : Comp}(e : CompEls c)(e' : CompEls c') → Set where
  addsub : {c' c : Comp}(c'c : isSubComp c' c)
           (e' : CompEls c')
           (e : CompEls c)
           (isOpt : IsOptimized)
           → e' <c add c'c e' e isOpt

  addlift : {c' c : Comp}(c'c : isSubComp c' c)
           (e' : CompEls c')
           (e : CompEls c)
           (isOpt : IsOptimized)
           → e <c add c'c e' e isOpt

data _<c+_  : {c c' : Comp}(e : CompEls c)(e' : CompEls c') → Set where
  in1 : {c c' : Comp} (e : CompEls c)(e' : CompEls c')
        (ee' : e <c e') → e <c+ e'
  in2 : {c c' c'' : Comp} (e : CompEls c)(e' : CompEls c')(e'' : CompEls c'')
        (ee' : e <c e')(e'e'' : e' <c+ e'') → (e <c+ e'')

data _<=c+_ : {c c' : Comp}(e : CompEls c)(e' : CompEls c') → Set where

  in0= : {c : Comp} (e : CompEls c)
        →  e <=c+ e
  in2= : {c c' c'' : Comp} (e : CompEls c)(e' : CompEls c')
                               (e'' : CompEls c'')
        →  e <c e' → e' <=c+ e'' → e <=c+ e''

in1= : {c c' : Comp} (e : CompEls c)(e' : CompEls c')
        (ee' : e <c e') → e <=c+ e'
in1= e e' ee' = in2= e e' e' ee' (in0= e')

trans<=c+ : {c c' c'' : Comp} (e : CompEls c)(e' : CompEls c')
                                   (e'' : CompEls c'')
            (ee' : e <=c+ e')
            (e'e'' : e' <=c+ e'')
            → e <=c+ e''
trans<=c+ {c} {.c} {c''} e .e e'' (in0= .e) e'e'' = e'e''
trans<=c+ {c} {c'} {c''} e e' e'' (in2= .e e'₁ .e' ee'₁ e'₁e') e'e'' = in2= e e'₁ e'' ee'₁ (trans<=c+ e'₁ e' e'' e'₁e' e'e'')

--
--  DEC Equality
--
module _ where
  sameOptimized : IsOptimized → IsOptimized → Bool
  sameOptimized optimized optimized = true
  sameOptimized notOptimzed notOptimzed = true
  sameOptimized _ _ = false

  _≟CompBool_ : {c c' : Comp} → CompEls c → CompEls c' → Bool
  _≟CompBool_ {frame} {frame} (add c₁c₂ c₁ c₂ isOpt) (add c₃c₄ c₃ c₄ isOpt') =
    (c₁ ≟CompBool c₃) ∧ (c₂ ≟CompBool c₄) ∧ (sameOptimized isOpt isOpt')

  _≟CompBool_ {atomicComp} {atomicComp} (add {frame} () _ _ _)
  _≟CompBool_ {atomicComp} {atomicComp} (add {atomicComp} () _ _ _)

  _≟CompBool_ {frame} {frame} (createC tt) (createC tt) = true
  _≟CompBool_ {atomicComp} {atomicComp} (createC (button x)) (createC (button y)) = x ==Str y
  _≟CompBool_ {atomicComp} {atomicComp} (createC (txtbox x)) (createC (txtbox y)) = x ==Str y

  _≟CompBool_ {atomicComp} {atomicComp} (createC (button x)) (createC (txtbox y)) = false
  _≟CompBool_ {atomicComp} {atomicComp} (createC (txtbox x)) (createC (button y)) = false

  _≟CompBool_ {frame} {atomicComp} _ _ = false
  _≟CompBool_ {atomicComp} {frame} _ _ = false

  createC _ ≟CompBool add _ _ _ _ = false
  add _ _ _ _ ≟CompBool createC _ = false

  unused = Dec

{- add buttonFrame a c notOptimzed ≡ add buttonFrame b d notOptimzedadd buttonFrame a c notOptimzed ≡ add buttonFrame b d notOptimzed -}
  lemmaAddEqProj1 : ∀ {a} {c} {opt} {b} {d} {opt'} → add buttonFrame a c opt ≡ add buttonFrame b d opt' → a ≡ b
  lemmaAddEqProj1 refl = refl

  lemmaAddEqProj2 : ∀ {a} {c} {opt} {b} {d} {opt'} → add buttonFrame a c opt ≡ add buttonFrame b d opt' → c ≡ d
  lemmaAddEqProj2 refl = refl

  lemmaCreateCBtnEq : ∀ {s1} {s2} → ((createC (button s1))  ≡ (createC (button s2))) → (s1 ≡ s2)
  lemmaCreateCBtnEq refl = refl

  lemmaCreateCTxtbxEq : ∀ {s1} {s2} → ((createC (txtbox s1))  ≡ (createC (txtbox s2))) → (s1 ≡ s2)
  lemmaCreateCTxtbxEq refl = refl

  mutual
   _≟CompFr_ : Decidable {A = CompEls frame} _≡_
   createC tt ≟CompFr createC tt = Dec.yes refl
   createC tt ≟CompFr add  _ _ _ _ = Dec.no (λ ())
   add _ _ _ _ ≟CompFr createC _ = Dec.no (λ ())
   add _ _ _ optimized ≟CompFr add _ _ _ notOptimzed = Dec.no (λ ())
   add _ _ _ notOptimzed ≟CompFr add _ _ _ optimized =  Dec.no (λ ())

   add buttonFrame a c optimized ≟CompFr add buttonFrame b d optimized with (a ≟Comp b) | (c ≟Comp d)
   ... | Dec.yes p | Dec.yes q = yes (cong₂ (λ x y → add buttonFrame x y optimized ) p q)
   ... | Dec.yes p | Dec.no ¬p = no (λ addp → ¬p (lemmaAddEqProj2 addp))
   ... | Dec.no ¬p | _ = no ((λ addp → ¬p (lemmaAddEqProj1 addp)))

   add buttonFrame a c notOptimzed ≟CompFr add buttonFrame b d notOptimzed with (a ≟Comp b) | (c ≟Comp d)
   ... | yes p | yes q = yes (cong₂ (λ x y → add buttonFrame x y notOptimzed ) p q)
   ... | yes p | no ¬p = no (λ addp → ¬p (lemmaAddEqProj2 addp))
   ... | no ¬p | q = no ((λ addp → ¬p (lemmaAddEqProj1 addp)))

   _≟Comp_ : {c : Comp} → Decidable {A = CompEls c} _≡_

   _≟Comp_ (createC _) (add _ _ _ isOpt) = Dec.no (λ ())
   _≟Comp_ (add _ _ _ isOpt) (createC _) = Dec.no (λ ())

   _≟Comp_ {atomicComp} (add () a b isOpt) (add cd c d isOpt')

   _≟Comp_ {frame} (createC tt) (createC tt) = Dec.yes refl

   _≟Comp_ {atomicComp} (createC (button s1)) (createC (button s2)) with (s1 ≟Str s2)
   ... | Dec.yes p = Dec.yes (cong (createC ∘ button) p)
   ... | Dec.no q = Dec.no  (λ neq →   q  (lemmaCreateCBtnEq neq)  )

   _≟Comp_ {atomicComp} (createC (txtbox s1)) (createC (txtbox s2)) with (s1 ≟Str s2)
   ... | Dec.yes p = Dec.yes (cong (createC ∘ txtbox) p)
   ... | Dec.no q = Dec.no (λ neq →   q  (lemmaCreateCTxtbxEq neq)  )

   _≟Comp_ {atomicComp} (createC (button s1)) (createC (txtbox s2)) = Dec.no (λ ())
   _≟Comp_ {atomicComp} (createC (txtbox s1)) (createC (button s2)) = Dec.no (λ ())

   _≟Comp_ {frame} (add c'c x x₁ isOpt) (add c'c₁ y y₁ isOpt₁) =
       _≟CompFr_ (add c'c x x₁ isOpt) (add c'c₁ y y₁ isOpt₁)

create-frame : CompEls frame
create-frame = createC{frame} tt

create-button : (s : String) → CompEls atomicComp
create-button s = createC{atomicComp} (button s)

create-txtbox : (s : String) → CompEls atomicComp
create-txtbox s = createC{atomicComp} (txtbox s)

validAdd : (c c' : Comp) → Set
validAdd atomicComp frame = ⊤
validAdd _ _ = ⊥

addReturnType : (c c' : Comp){_ : validAdd c c'} → Set
addReturnType atomicComp frame = CompEls frame
addReturnType frame frame {()}
addReturnType frame atomicComp {()}
addReturnType atomicComp atomicComp {()}

add' : {c c' : Comp}{va : validAdd c c'} → CompEls c → CompEls c'
      → (isOpt : IsOptimized) → addReturnType c c'{va}
add' {atomicComp} {frame} bt fr isOpt = add buttonFrame bt fr isOpt
add' {frame} {frame} {()} isOpt
add' {frame} {atomicComp} {()} isOpt
add' {atomicComp} {atomicComp} {()} isOpt

properties : {c : Comp}(e : CompEls c) → Set
properties {c} (add c'c e e' isOpt) = properties e × properties e'
properties {frame} (createC x) = (ℕ × ℕ × ℕ × ℕ)
properties {atomicComp} (createC x) = WxColor

ComponentEls : Comp → Set
ComponentEls = CompEls

Component : Set
Component = Comp


module Base.Free.Instance.Identity where

open import Data.Empty using (⊥)

open import Base.Free  using (Free)

-- Representation of the `Identity` monad using free.
Shape : Set
Shape = ⊥

Position : Shape → Set
Position _ = ⊥

Identity : Set → Set
Identity = Free Shape Position


{-# OPTIONS --allow-unsolved-metas #-}

module TemporalOps.Linear where

open import CategoryTheory.Instances.Reactive
open import CategoryTheory.Functor
open import CategoryTheory.CartesianStrength
open import CategoryTheory.NatTrans
open import CategoryTheory.Monad
open import CategoryTheory.Linear

open import TemporalOps.Next
open import TemporalOps.Delay
open import TemporalOps.Diamond
open import TemporalOps.OtherOps
open import TemporalOps.Common.Other
open import TemporalOps.Common.Compare
open import TemporalOps.Common.Rewriting

open import Data.Product
open import Data.Product.Properties
open import Data.Sum
open import Data.Nat hiding (_*_)
open import Data.Nat.Properties
            using (+-identityʳ ; +-comm ; +-suc ; +-assoc)

open import Relation.Binary.PropositionalEquality hiding (inspect)

open import Holes.Term using (⌞_⌟)
open import Holes.Cong.Propositional

open ≡-Reasoning

open L ℝeactive-BCCC M-◇ public

ℝeactive-linear : Linear ℝeactive-BCCC M-◇
ℝeactive-linear = record
    { linprod = λ A B →
    record { ⟪_,_⟫ = prod-◇
           ; *π₁-comm = λ {C} {l₁} {l₂} {n} {a} →
                        *π₁-comm-◇ {A}{B}{C} {l₁} {l₂} {n} {a}
           ; *π₂-comm = {!   !}
           ; ⊛-unique = {!   !}
           }
    }
    where
    open Functor F-▹
    open Functor F-◇ renaming (fmap to ◇-f)
    private module ▹ᵏ-F k = Functor (F-delay k)
    private module ▹ᵏ-◇ k = _⟹_ (▹ᵏ-to-◇ k)
    private module ▹ᵏ-C k = CartesianFunctor (F-cart-delay k)
    open Monad M-◇
    open CartesianFunctor F-cart-▹ renaming (m to m-▹)

    pair-delay-◇₁ : ∀{A B : τ} -> (k l : ℕ) -> (delay A by suc (k + l) ⊗ delay B by k)
                                   ⇴ delay (◇ A ⊗ B) by k
    pair-delay-◇₁ zero l n (dA , dB) = (suc l , dA) , dB
    pair-delay-◇₁ {A}{B} (suc k) l n p = fmap (pair-delay-◇₁ k l) n
        (m-▹ (delay A by suc (k + l)) (delay B by k) n p)

    pair-delay-◇₂ : ∀{A B : τ} -> (k l : ℕ) -> (delay A by k ⊗ delay B by suc (k + l))
                                   ⇴ delay (A ⊗ ◇ B) by k
    pair-delay-◇₂ zero l n (dA , dB) = dA , (suc l , dB)
    pair-delay-◇₂ {A}{B} (suc k) l n p = fmap (pair-delay-◇₂ k l) n
        (m-▹ (delay A by k) (delay B by suc (k + l)) n p)

    prod-◇-compare : ∀{A B : τ} -> (k₁ k₂ n : ℕ)
                  -> (a₁ : delay A by k₁ at n)(a₂ : delay B by k₂ at n)
                  -> Ordering k₁ k₂ -> ◇ (A ⊛ B) at n
    prod-◇-compare {A} {B} k₁ .(suc (k₁ + l)) n a₁ a₂ (less .k₁ l) =
        k₁ , ▹ᵏ-F.fmap k₁ ι₁ n (▹ᵏ-F.fmap k₁ ι₁ n (pair-delay-◇₂ k₁ l n (a₁ , a₂)))
    prod-◇-compare {A} {B} .(suc (k₂ + l)) k₂ n a₁ a₂ (greater .k₂ l) =
        k₂ , ▹ᵏ-F.fmap k₂ ι₁ n (▹ᵏ-F.fmap k₂ ι₂ n (pair-delay-◇₁ k₂ l n (a₁ , a₂)))
    prod-◇-compare {A} {B} k₁ .k₁ n a₁ a₂ (equal .k₁) =
        k₁ , ▹ᵏ-F.fmap k₁ ι₂ n (▹ᵏ-C.m k₁ A B n (a₁ , a₂))

    ◇-select : ∀{A B : τ} -> (◇ A ⊗ ◇ B) ⇴ ◇ (A ⊛ B)
    ◇-select {A}{B} n ((k₁ , a₁) , (k₂ , a₂)) =
        prod-◇-compare {A}{B} k₁ k₂ n a₁ a₂ (compare k₁ k₂)

    prod-◇ : ∀{A B L : τ} -> (L ⇴ ◇ A) -> (L ⇴ ◇ B) -> (L ⇴ ◇ (A ⊛ B))
    prod-◇ fa fb n lp = ◇-select n (fa n lp , fb n lp)

    *π₁-comm-◇ : ∀{A B L} -> {l₁ : L ⇴ ◇ A} {l₂ : L ⇴ ◇ B}
           -> (μ.at A ∘ ◇-f *π₁) ∘ (prod-◇ l₁ l₂) ≈ l₁
    *π₁-comm-◇ {A}{B}{L}{l₁}{l₂} {n} {a} with inspect (l₁ n a , l₂ n a)
    *π₁-comm-◇ | ((k₁ , a₁) , (k₂ , a₂)) with≡ pf with inspect (compare k₁ k₂)
    *π₁-comm-◇ {A}{B}{L}{l₁}{l₂}{n}{a} | ((k₁ , a₁) , .(suc (k₁ + l)) , a₂) with≡ pf
                                           | less .k₁ l with≡ cpf =
        begin
            (μ.at A n (◇-f *π₁ n (◇-select n ⌞ (l₁ n a , l₂ n a) ⌟)))
        ≡⟨ cong! pf ⟩
            μ.at A n (◇-f *π₁ n
                (prod-◇-compare k₁ (suc (k₁ + l)) n a₁ a₂ (⌞ compare k₁ (suc (k₁ + l)) ⌟)))
        ≡⟨ cong! cpf ⟩
            μ.at A n (◇-f *π₁ n
                (prod-◇-compare k₁ (suc (k₁ + l)) n a₁ a₂ (less k₁ l)))
        ≡⟨⟩
            μ.at A n (k₁ ,
                ▹ᵏ-F.fmap k₁ *π₁ n ⌞ (▹ᵏ-F.fmap k₁ ι₁ n (▹ᵏ-F.fmap k₁ ι₁ n
                    (pair-delay-◇₂ k₁ l n (a₁ , a₂)))) ⌟)
        ≡⟨ cong! (▹ᵏ-F.fmap-∘ k₁ {g = ι₁ {A ⊗ ◇ B ⊕ ◇ A ⊗ B} {A ⊗ B}}
                                    {ι₁ {A ⊗ ◇ B} {◇ A ⊗ B}}{n} {pair-delay-◇₂ k₁ l n (a₁ , a₂)}) ⟩
            μ.at A n (k₁ ,
                ⌞ ▹ᵏ-F.fmap k₁ *π₁ n (▹ᵏ-F.fmap k₁ (ι₁ ∘ ι₁) n
                    (pair-delay-◇₂ k₁ l n (a₁ , a₂))) ⌟)
        ≡⟨ cong! (▹ᵏ-F.fmap-∘ k₁ {g = *π₁} {ι₁ ∘ ι₁} {n} {pair-delay-◇₂ k₁ l n (a₁ , a₂)}) ⟩
            μ.at A n (k₁ ,
                ▹ᵏ-F.fmap k₁ ([ η.at A ∘ π₁ ⁏ π₁ {B = L} ⁏ η.at A ∘ π₁ {B = L} ] ∘ ι₁ ∘ ι₁) n
                    (pair-delay-◇₂ k₁ l n (a₁ , a₂)))
        ≡⟨⟩
            μ.at A n (k₁ ,
                ⌞ ▹ᵏ-F.fmap k₁ (η.at A ∘ π₁) n
                    (pair-delay-◇₂ k₁ l n (a₁ , a₂)) ⌟)
        ≡⟨ cong! (▹ᵏ-F.fmap-∘ k₁) ⟩
            μ.at A n (k₁ , ▹ᵏ-F.fmap k₁ (η.at A) n
                ⌞ ▹ᵏ-F.fmap k₁ π₁ n (pair-delay-◇₂ k₁ l n (a₁ , a₂)) ⌟)
        ≡⟨ cong! (lemma k₁ l {n} {a₁ , a₂}) ⟩
            μ.at A n (k₁ , ▹ᵏ-F.fmap k₁ (η.at A) n a₁)
        ≡⟨ η-unit2 ⟩
            k₁ , a₁
        ≡⟨ sym (,-injectiveˡ pf) ⟩
            l₁ n a
        ∎
        where
        lemma : ∀ (k l : ℕ) -> ▹ᵏ-F.fmap k π₁ ∘ pair-delay-◇₂ k l ≈ π₁
        lemma zero l = refl
        lemma (suc k) l {zero} = refl
        lemma (suc k) l {suc n} = lemma k l {n}

    *π₁-comm-◇ {A}{B}{L}{l₁}{l₂}{n}{a} | ((.(suc (k₂ + l)) , a₁) , k₂ , a₂) with≡ pf
                                      | greater .k₂ l  with≡ cpf  =
        begin
            (μ.at A n (◇-f *π₁ n (◇-select n ⌞ (l₁ n a , l₂ n a) ⌟)))
        ≡⟨ cong! pf ⟩
            μ.at A n (◇-f *π₁ n
                (prod-◇-compare (suc (k₂ + l)) k₂ n a₁ a₂ (⌞ compare (suc (k₂ + l)) k₂ ⌟)))
        ≡⟨ cong! cpf ⟩
            μ.at A n (◇-f *π₁ n
                (prod-◇-compare (suc (k₂ + l)) k₂ n a₁ a₂ (greater k₂ l)))
        ≡⟨⟩
            μ.at A n (k₂ ,
                ▹ᵏ-F.fmap k₂ *π₁ n ⌞ (▹ᵏ-F.fmap k₂ ι₁ n (▹ᵏ-F.fmap k₂ ι₂ n
                    (pair-delay-◇₁ k₂ l n (a₁ , a₂)))) ⌟)
        ≡⟨ cong! (▹ᵏ-F.fmap-∘ k₂ {g = ι₁ {A ⊗ ◇ B ⊕ ◇ A ⊗ B} {A ⊗ B}}
                                    {ι₂ {A ⊗ ◇ B} {◇ A ⊗ B}}{n} {pair-delay-◇₁ k₂ l n (a₁ , a₂)}) ⟩
            μ.at A n (k₂ ,
                ⌞ ▹ᵏ-F.fmap k₂ *π₁ n (▹ᵏ-F.fmap k₂ (ι₁ ∘ ι₂) n
                    (pair-delay-◇₁ k₂ l n (a₁ , a₂))) ⌟)
        ≡⟨ cong! (▹ᵏ-F.fmap-∘ k₂ {g = *π₁} {ι₁ ∘ ι₂} {n} {pair-delay-◇₁ k₂ l n (a₁ , a₂)}) ⟩
            μ.at A n (k₂ ,
                ▹ᵏ-F.fmap k₂ ([ η.at A ∘ π₁ {B = L} ⁏ π₁ {B = B} ⁏ η.at A ∘ π₁ {B = L} ] ∘ ι₁ ∘ ι₂) n
                    (pair-delay-◇₁ k₂ l n (a₁ , a₂)))
        ≡⟨⟩
            μ.at A n (k₂ , ⌞ ▹ᵏ-F.fmap k₂ π₁ n (pair-delay-◇₁ k₂ l n (a₁ , a₂)) ⌟)
        ≡⟨ refl ⟩
            μ.at A n (◇-f π₁ n (k₂ , pair-delay-◇₁ k₂ l n (a₁ , a₂)))
        ≡⟨ {!   !} ⟩
        -- ≡⟨ cong! (lemma k₂ l {n} {a₁ , a₂}) ⟩
        --     μ.at A n (k₂ , ▹ᵏ-F.fmap k₂ (▹ᵏ-◇.at (suc l) A) n (split-▹ᵏ k₂ l n a₁))
            suc (k₂ + l) , a₁
        ≡⟨ sym (,-injectiveˡ pf) ⟩
            l₁ n a
        ∎
        where
        split-▹ᵏ : ∀ {A} k l -> delay A by suc (k + l) ⇴ delay (delay A by suc l) by k
        split-▹ᵏ zero l n a = a
        split-▹ᵏ (suc k) l zero a = top.tt
        split-▹ᵏ (suc k) l (suc n) a = split-▹ᵏ k l n a

        lemma : ∀ {A B} (k l  : ℕ)
             -> ▹ᵏ-F.fmap k (π₁ {B = B}) ∘ pair-delay-◇₁ {A} k l
              ≈ ▹ᵏ-F.fmap k (▹ᵏ-◇.at (suc l) A) ∘ split-▹ᵏ k l ∘ π₁
        lemma zero l {n} = refl
        lemma (suc k) l {zero} = refl
        lemma (suc k) l {suc n} = lemma k l

        lemma2 : ∀ {A B} k l n (a₁ : delay A by suc (k + l) at n)
                               (a₂ : delay B by k at n)
              -> μ.at A n (◇-f π₁ n (k , pair-delay-◇₁ k l n (a₁ , a₂)))
               ≡ (suc (k + l) , a₁)
        lemma2 zero l n a₁ a₂ = refl
        lemma2 (suc k) l zero a₁ a₂ = {!   !}
        lemma2 (suc k) l (suc n) a₁ a₂ = {!   !}

    *π₁-comm-◇ {l₁ = l₁} {l₂} {n} {a} | ((k₁ , a₁) , .k₁ , a₂) with≡ pf
                                      | equal .k₁  with≡ cpf = {!   !}

open Linear ℝeactive-linear public

-- Handle a linear product with three continuations
handle : ∀ {A B C D : τ}
          -> (A ⊗   B ⊗ ◇ C ⇴ ◇ D)
          -> (A ⊗ ◇ B ⊗   C ⇴ ◇ D)
          -> (A ⊗   B ⊗   C ⇴ ◇ D)
          -> A ⊗ (B ⊛ C)    ⇴ ◇ D
handle a b c = [ a ∘ assoc-left ⁏ b ∘ assoc-left ⁏ c ∘ assoc-left ] ∘ dist2


------------------------------------------------------------------------
-- Some results about various forms of coinductively defined weak
-- bisimilarity for the delay monad
------------------------------------------------------------------------

{-# OPTIONS --sized-types #-}

open import Prelude

module Bisimilarity.Weak.Delay-monad {a} {A : Type a} where

open import Delay-monad
open import Delay-monad.Bisimilarity as DB using (force)
import Delay-monad.Bisimilarity.Negative as DN
open import Equality.Propositional
open import Logical-equivalence using (_⇔_)
open import Prelude.Size

open import Function-universe equality-with-J hiding (id; _∘_)
open import Function-universe.Size equality-with-J

import Bisimilarity.Delay-monad as SD
import Bisimilarity.Weak.Alternative.Equational-reasoning-instances
import Bisimilarity.Weak.Equational-reasoning-instances
open import Bisimilarity.Weak.Equivalent
open import Equational-reasoning
import Expansion.Delay-monad as ED
open import Labelled-transition-system.Delay-monad A

open import Bisimilarity delay-monad using ([_]_∼_)
open import Bisimilarity.Weak delay-monad
open import Bisimilarity.Weak.Alternative delay-monad as AW
  using (force)
open import Expansion delay-monad as BE using ([_]_≳_; _≳_)

------------------------------------------------------------------------
-- Several definitions of weak bisimilarity are pointwise logically
-- equivalent

-- Emulations of the constructors DW.later, DW.laterˡ and DW.laterʳ.

later-cong : ∀ {i x y} →
             [ i ] force x ≈′ force y → [ i ] later x ≈ later y
later-cong x≈′y =
  ⟨ (λ { later → _ , ⟶→⇒̂ later , x≈′y })
  , (λ { later → _ , ⟶→⇒̂ later , x≈′y })
  ⟩

laterˡ : ∀ {i x y} → [ i ] force x ≈ y → [ i ] later x ≈ y
laterˡ x≈y =
  ⟨ (λ { later → _ , silent _ done , convert {a = a} x≈y })
  , Σ-map id (Σ-map later⇒̂ id) ∘ right-to-left x≈y
  ⟩

laterʳ : ∀ {i x y} → [ i ] x ≈ force y → [ i ] x ≈ later y
laterʳ x≈y =
  ⟨ Σ-map id (Σ-map later⇒̂ id) ∘ left-to-right x≈y
  , (λ { later → _ , silent _ done , convert {a = a} x≈y })
  ⟩

-- The direct definition of weak bisimilarity is contained in the form
-- of weak bisimilarity obtained from the transition relation.

direct→indirect : ∀ {i x y} →
                  DB.[ i ] x ≈ y → [ i ] x ≈ y
direct→indirect DB.now        = reflexive
direct→indirect (DB.later  p) = later-cong λ { .force →
                                  direct→indirect (force p) }
direct→indirect (DB.laterˡ p) = laterˡ (direct→indirect p)
direct→indirect (DB.laterʳ p) = laterʳ (direct→indirect p)

mutual

  -- The definition of weak bisimilarity obtained from the transition
  -- relation is contained in the direct one.

  indirect→direct : ∀ {i} x y → [ i ] x ≈ y → DB.[ i ] x ≈ y
  indirect→direct {i} (now x) y =
    [ i ] now x ≈ y                                  ↝⟨ (λ p → left-to-right p now) ⟩
    (∃ λ y′ → y [ just x ]⇒̂ y′ × [ i ] now x ≈′ y′)  ↝⟨ DB.≳→ ∘ ED.[just]⇒̂→≳now ∘ proj₁ ∘ proj₂ ⟩
    DB.[ i ] y ≈ now x                               ↝⟨ DB.symmetric ⟩□
    DB.[ i ] now x ≈ y                               □

  indirect→direct {i} x (now y) =
    [ i ] x ≈ now y                                  ↝⟨ (λ p → right-to-left p now) ⟩
    (∃ λ x′ → x [ just y ]⇒̂ x′ × [ i ] x′ ≈′ now y)  ↝⟨ DB.≳→ ∘ ED.[just]⇒̂→≳now ∘ proj₁ ∘ proj₂ ⟩□
    DB.[ i ] x ≈ now y                               □

  indirect→direct (later x) (later y) lx≈ly
    with left-to-right lx≈ly later

  ... | y′ , non-silent contradiction _ , _ =
    ⊥-elim (contradiction _)

  ... | y′ , silent _ (step _ later y⇒y′) , x≈′y′ =
    DB.later λ { .force →
      indirect→direct′ y⇒y′ (force x≈′y′) }

  ... | y′ , silent _ done , x≈′ly
    with right-to-left lx≈ly later

  ...   | x′ , non-silent contradiction _ , _ =
    ⊥-elim (contradiction _)

  ...   | x′ , silent _ (step _ later x⇒x′) , x′≈′y =
    DB.later λ { .force →
      DB.symmetric $
      indirect→direct′ x⇒x′ $
      symmetric (force x′≈′y) }

  ...   | x′ , silent _ done , lx≈′y =
    DB.later λ { .force →
      DB.laterˡʳ⁻¹
        (indirect→direct _ _ (force lx≈′y))
        (indirect→direct _ _ (force x≈′ly)) }

  private

    -- A lemma used by indirect→direct.

    indirect→direct′ : ∀ {i x y y′} →
                       y ⇒ y′ → [ i ] x ≈ y′ → DB.[ i ] x ≈ y
    indirect→direct′ done               p = indirect→direct _ _ p
    indirect→direct′ (step _  later tr) p = DB.laterʳ (indirect→direct′ tr p)
    indirect→direct′ (step () now   _)

-- The direct definition of weak bisimilarity is logically equivalent
-- to the one obtained from the transition relation.
--
-- TODO: Are the two definitions isomorphic?

direct⇔indirect : ∀ {i x y} → DB.[ i ] x ≈ y ⇔ [ i ] x ≈ y
direct⇔indirect = record
  { to   = direct→indirect
  ; from = indirect→direct _ _
  }

-- The direct definition of weak bisimilarity is logically equivalent
-- to the alternative, coinductive form of weak bisimilarity obtained
-- from the transition relation. Note that this proof is not
-- size-preserving.

direct⇔alternative : ∀ {x y} → x DB.≈ y ⇔ x AW.≈ y
direct⇔alternative {x} {y} =
  x DB.≈ y  ↝⟨ direct⇔indirect ⟩
  x ≈ y     ↝⟨ inverse alternative⇔ ⟩□
  x AW.≈ y  □

------------------------------------------------------------------------
-- A non-existence result for the alternative, coinductive indirect
-- definition of weak bisimilarity

private

  -- If A is uninhabited, then AW._≈_ is trivial.

  uninhabited→trivial : ¬ A → ∀ x y → x AW.≈ y
  uninhabited→trivial =
    ¬ A                 ↝⟨ DB.uninhabited→trivial ⟩
    (∀ x y → x DB.≈ y)  ↝⟨ ∀-cong _ (λ _ → ∀-cong _ λ _ → _⇔_.to direct⇔alternative) ⟩
    (∀ x y → x AW.≈ y)  □

-- One can define a size-preserving "later-cong" function iff A is
-- uninhabited.

Later-cong =
  ∀ {i x y} →
  AW.[ i ] force x ≈′ force y → AW.[ i ] later x ≈ later y

size-preserving-later-cong⇔uninhabited : Later-cong ⇔ ¬ A
size-preserving-later-cong⇔uninhabited = record
  { to   = Later-cong                ↝⟨ (λ later-cong → now≈never (λ {i} → later-cong {i})) ⟩
           (∀ x → now x AW.≈ never)  ↝⟨ ∀-cong _ (λ _ → _⇔_.from direct⇔alternative) ⟩
           (∀ x → now x DB.≈ never)  ↝⟨ (λ hyp → DB.now≉never ∘ hyp) ⟩□
           ¬ A                       □
  ; from = ¬ A                 ↝⟨ uninhabited→trivial ⟩
           (∀ x y → x AW.≈ y)  ↝⟨ (λ trivial {_ _ _} _ → trivial _ _) ⟩□
           Later-cong          □
  }
  where

  module _ (later-cong : Later-cong) where

    now≈never : ∀ {i} x → AW.[ i ] now x ≈ never
    now≈never x =
      now x                         ∼⟨ ⇒alternative (laterʳ reflexive) ⟩
      later (λ { .force → now x })  ∼⟨ later-cong (λ { .force → now≈never x }) ⟩■
      never

------------------------------------------------------------------------
-- Some non-existence results for the standard indirect definition of
-- weak bisimilarity

-- There is a transitivity proof that takes weak bisimilarity and
-- expansion to expansion iff A is uninhabited.

Transitivity-≈≳≳ = {x y z : Delay A ∞} → x ≈ y → y ≳ z → x ≳ z
Transitivity-≳≈≳ = {x y z : Delay A ∞} → x ≳ y → y ≈ z → x ≳ z

transitive-≈≳≳⇔uninhabited : Transitivity-≈≳≳ ⇔ ¬ A
transitive-≈≳≳⇔uninhabited =
  Transitivity-≈≳≳     ↝⟨ inverse $ implicit-∀-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $
                          →-cong _ direct⇔indirect (→-cong _ ED.direct⇔indirect ED.direct⇔indirect) ⟩
  DN.Transitivity-≈≳≳  ↝⟨ DN.transitive-≈≳≳⇔uninhabited ⟩□
  ¬ A                  □

transitive-≳≈≳⇔uninhabited : Transitivity-≳≈≳ ⇔ ¬ A
transitive-≳≈≳⇔uninhabited =
  Transitivity-≳≈≳     ↝⟨ inverse $ implicit-∀-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $
                          →-cong _ ED.direct⇔indirect (→-cong _ direct⇔indirect ED.direct⇔indirect) ⟩
  DN.Transitivity-≳≈≳  ↝⟨ DN.transitive-≳≈≳⇔uninhabited ⟩□
  ¬ A                  □

-- There is a transitivity proof that preserves the size of the second
-- argument iff A is uninhabited.

Transitivityʳ =
  ∀ {i} {x y z : Delay A ∞} →
  x ≈ y → [ i ] y ≈ z → [ i ] x ≈ z

size-preserving-transitivityʳ⇔uninhabited : Transitivityʳ ⇔ ¬ A
size-preserving-transitivityʳ⇔uninhabited =
  Transitivityʳ       ↝⟨ inverse $ implicit-∀-size-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $
                         →-cong _ direct⇔indirect $ →-cong _ direct⇔indirect direct⇔indirect ⟩
  DN.Transitivity-≈ʳ  ↝⟨ DN.size-preserving-transitivity-≈ʳ⇔uninhabited ⟩□
  ¬ A                 □

-- There is a transitivity proof that preserves the size of the first
-- argument iff A is uninhabited.

Transitivityˡ =
  ∀ {i} {x y z : Delay A ∞} →
  [ i ] x ≈ y → y ≈ z → [ i ] x ≈ z

size-preserving-transitivityˡ⇔uninhabited : Transitivityˡ ⇔ ¬ A
size-preserving-transitivityˡ⇔uninhabited =
  Transitivityˡ       ↝⟨ inverse $ implicit-∀-size-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $
                         →-cong _ direct⇔indirect $ →-cong _ direct⇔indirect direct⇔indirect ⟩
  DN.Transitivity-≈ˡ  ↝⟨ DN.size-preserving-transitivity-≈ˡ⇔uninhabited ⟩□
  ¬ A                 □

-- There is a transitivity proof that preserves the size of the second
-- argument, a strong bisimilarity, iff A is uninhabited.

Transitivity-≈∼ʳ =
  ∀ {i} {x y z : Delay A ∞} →
  x ≈ y → [ i ] y ∼ z → [ i ] x ≈ z

size-preserving-transitivity-≈∼ʳ⇔uninhabited : Transitivity-≈∼ʳ ⇔ ¬ A
size-preserving-transitivity-≈∼ʳ⇔uninhabited =
  Transitivity-≈∼ʳ     ↝⟨ inverse $ implicit-∀-size-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $
                          →-cong _ direct⇔indirect $ →-cong _ SD.direct⇔indirect direct⇔indirect ⟩
  DN.Transitivity-≈∼ʳ  ↝⟨ DN.size-preserving-transitivity-≈∼ʳ⇔uninhabited ⟩□
  ¬ A                  □

-- There is a transitivity proof that preserves the size of the first
-- argument, a strong bisimilarity, iff A is uninhabited.

Transitivity-∼≈ˡ =
  ∀ {i} {x y z : Delay A ∞} →
  [ i ] x ∼ y → y ≈ z → [ i ] x ≈ z

size-preserving-transitivity-∼≈ˡ⇔uninhabited : Transitivity-∼≈ˡ ⇔ ¬ A
size-preserving-transitivity-∼≈ˡ⇔uninhabited =
  Transitivity-∼≈ˡ     ↝⟨ inverse $ implicit-∀-size-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $
                          →-cong _ SD.direct⇔indirect $ →-cong _ direct⇔indirect direct⇔indirect ⟩
  DN.Transitivity-∼≈ˡ  ↝⟨ DN.size-preserving-transitivity-∼≈ˡ⇔uninhabited ⟩□
  ¬ A                  □

-- There is a transitivity-like proof that preserves the size of the
-- first argument, an expansion, iff A is uninhabited.

Transitivity-≳≈ˡ =
  ∀ {i} {x y z : Delay A ∞} →
  [ i ] x ≳ y → y ≈ z → [ i ] x ≈ z

size-preserving-transitivity-≳≈ˡ⇔uninhabited : Transitivity-≳≈ˡ ⇔ ¬ A
size-preserving-transitivity-≳≈ˡ⇔uninhabited =
  Transitivity-≳≈ˡ     ↝⟨ inverse $ implicit-∀-size-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $
                          →-cong _ ED.direct⇔indirect (→-cong _ direct⇔indirect direct⇔indirect) ⟩
  DN.Transitivity-≳≈ˡ  ↝⟨ DN.size-preserving-transitivity-≳≈ˡ⇔uninhabited ⟩□
  ¬ A                  □

-- There is a transitivity-like proof that takes an expansion as the
-- first argument, and preserves the size of both arguments, iff A is
-- uninhabited.

Transitivity-≳≈ =
  ∀ {i} {x y z : Delay A ∞} →
  [ i ] x ≳ y → [ i ] y ≈ z → [ i ] x ≈ z

size-preserving-transitivity-≳≈⇔uninhabited : Transitivity-≳≈ ⇔ ¬ A
size-preserving-transitivity-≳≈⇔uninhabited =
  Transitivity-≳≈     ↝⟨ inverse $ implicit-∀-size-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $
                         →-cong _ ED.direct⇔indirect (→-cong _ direct⇔indirect direct⇔indirect) ⟩
  DN.Transitivity-≳≈  ↝⟨ DN.size-preserving-transitivity-≳≈⇔uninhabited ⟩□
  ¬ A                 □

-- There is a transitivity-like proof that preserves the size of the
-- second argument, an expansion (with the arguments swapped), iff A
-- is uninhabited.

Transitivity-≈≲ʳ =
  ∀ {i} {x y z : Delay A ∞} →
  x ≈ y → [ i ] z ≳ y → [ i ] x ≈ z

size-preserving-transitivity-≈≲ʳ⇔uninhabited : Transitivity-≈≲ʳ ⇔ ¬ A
size-preserving-transitivity-≈≲ʳ⇔uninhabited =
  Transitivity-≈≲ʳ     ↝⟨ inverse $ implicit-∀-size-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $
                          →-cong _ direct⇔indirect (→-cong _ ED.direct⇔indirect direct⇔indirect) ⟩
  DN.Transitivity-≈≲ʳ  ↝⟨ DN.size-preserving-transitivity-≈≲ʳ⇔uninhabited ⟩□
  ¬ A                  □

-- There is a transitivity-like proof that takes an expansion (with
-- the arguments swapped) as the second argument, and preserves the
-- size of both arguments, iff A is uninhabited.

Transitivity-≈≲ =
  ∀ {i} {x y z : Delay A ∞} →
  [ i ] x ≈ y → [ i ] z ≳ y → [ i ] x ≈ z

size-preserving-transitivity-≈≲⇔uninhabited : Transitivity-≈≲ ⇔ ¬ A
size-preserving-transitivity-≈≲⇔uninhabited =
  Transitivity-≈≲     ↝⟨ inverse $ implicit-∀-size-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $
                         →-cong _ direct⇔indirect (→-cong _ ED.direct⇔indirect direct⇔indirect) ⟩
  DN.Transitivity-≈≲  ↝⟨ DN.size-preserving-transitivity-≈≲⇔uninhabited ⟩□
  ¬ A                 □

-- There is a transitivity-like proof that preserves the size of the
-- first argument, and takes an expansion as the second argument, iff
-- A is uninhabited.

Transitivity-≈≳ˡ =
  ∀ {i} {x y z : Delay A ∞} →
  [ i ] x ≈ y → y ≳ z → [ i ] x ≈ z

size-preserving-transitivity-≈≳ˡ⇔uninhabited : Transitivity-≈≳ˡ ⇔ ¬ A
size-preserving-transitivity-≈≳ˡ⇔uninhabited =
  Transitivity-≈≳ˡ     ↝⟨ inverse $ implicit-∀-size-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $ implicit-∀-cong _ $
                          →-cong _ direct⇔indirect (→-cong _ ED.direct⇔indirect direct⇔indirect) ⟩
  DN.Transitivity-≈≳ˡ  ↝⟨ DN.size-preserving-transitivity-≈≳ˡ⇔uninhabited ⟩□
  ¬ A                  □

------------------------------------------------------------------------
-- A non-existence result for both indirect definitions of weak
-- bisimilarity

-- The function ⇒alternative translating from the standard indirect
-- definition of weak bisimilarity to the alternative, coinductive one
-- can be made size-preserving iff A is uninhabited.

size-preserving-⇒alternative⇔uninhabited :
  (∀ {i p q} → [ i ] p ≈ q → AW.[ i ] p ≈ q) ⇔ ¬ A
size-preserving-⇒alternative⇔uninhabited = record
  { to =
      (∀ {i p q} → [ i ] p ≈ q → AW.[ i ] p ≈ q)  ↝⟨ (λ ⇒alternative x≈y y≈z →
                                                        alternative⇒ (transitive {a = a} (⇒alternative x≈y) (⇒alternative y≈z))) ⟩
      Transitivityʳ                               ↝⟨ _⇔_.to size-preserving-transitivityʳ⇔uninhabited ⟩□
      ¬ A                                         □
  ; from =
      ¬ A                                         ↝⟨ uninhabited→trivial ⟩
      (∀ x y → x AW.≈ y)                          ↝⟨ (λ trivial {_ _ _} _ → trivial _ _) ⟩□
      (∀ {i p q} → [ i ] p ≈ q → AW.[ i ] p ≈ q)  □
  }

------------------------------------------------------------------------
-- More lemmas

-- If x and y both make non-silent transitions of the same kind,
-- then they are weakly bisimilar.

⟶-with-equal-labels→≈ :
  ∀ {x x′ y y′ μ} →
  ¬ Silent μ → x [ μ ]⟶ x′ → y [ μ ]⟶ y′ → x ≈ y
⟶-with-equal-labels→≈ _  now   now = reflexive
⟶-with-equal-labels→≈ ¬s later _   = ⊥-elim (¬s _)

[]⇒-with-equal-labels→≈ :
  ∀ {x x′ y y′ μ} →
  ¬ Silent μ → x [ μ ]⇒ x′ → y [ μ ]⇒ y′ → x ≈ y
[]⇒-with-equal-labels→≈
  {x = x} {y = y} ¬s
  (steps {p′ = x′} x⇒x′ x′⟶x″ x″⇒x‴)
  (steps {p′ = y′} y⇒y′ y′⟶y″ y″⇒y‴) =

  x   ∼⟨ direct→indirect (DB.≳→ (ED.⇒→≳ x⇒x′)) ⟩
  x′  ∼⟨ ⟶-with-equal-labels→≈ ¬s x′⟶x″ y′⟶y″ ⟩
  y′  ∼⟨ symmetric (direct→indirect (DB.≳→ (ED.⇒→≳ y⇒y′))) ⟩■
  y

⇒̂-with-equal-labels→≈ :
  ∀ {x x′ y y′ μ} →
  ¬ Silent μ → x [ μ ]⇒̂ x′ → y [ μ ]⇒̂ y′ → x ≈ y
⇒̂-with-equal-labels→≈ ¬s (non-silent _ x⇒x′) (non-silent _ y⇒y′) =
  []⇒-with-equal-labels→≈ ¬s x⇒x′ y⇒y′
⇒̂-with-equal-labels→≈ ¬s   (silent s _) = ⊥-elim (¬s s)
⇒̂-with-equal-labels→≈ ¬s _ (silent s _) = ⊥-elim (¬s s)

⟶̂-with-equal-labels→≈ :
  ∀ {x x′ y y′ μ} →
  ¬ Silent μ → x [ μ ]⟶̂ x′ → y [ μ ]⟶̂ y′ → x ≈ y
⟶̂-with-equal-labels→≈ ¬s x⟶̂x′ y⟶̂y′ =
  ⇒̂-with-equal-labels→≈ ¬s (⟶̂→⇒̂ x⟶̂x′) (⟶̂→⇒̂ y⟶̂y′)


data ⊥ : Set where

record ⊤ : Set where
  constructor unit

data T : ⊥ → Set where
  con : (i : ⊥) → T i

module M (x : ⊤) where
  bar : (i : ⊥) → T i → ⊥
  bar .i (con i) = i
    module N where
      foo : ⊥
      foo = i

  -- Should not be accepted.
  -- Type signature should be `test : ⊥ → ⊥`
  test : ⊥ → ⊥
  test = N.foo

false : ⊥
false = M.test unit unit


{-#  OPTIONS --type-in-type #-}
module Bias where

open import AgdaPrelude

myFun : (a : Set) -> a -> a -> a -> a
myFun a x y z = x

--myApp1 = myFun _ Zero Zero (Nil Nat)

myApp2 = myFun _ (Nil Nat) Zero Zero