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

module Definition.Conversion.Weakening where

open import Definition.Untyped as U hiding (wk)
open import Definition.Untyped.Properties
open import Definition.Typed
open import Definition.Typed.Weakening
open import Definition.Typed.Consequences.Syntactic
open import Definition.Conversion
open import Definition.Conversion.Soundness

import Tools.PropositionalEquality as PE
open import Tools.Product

mutual
  -- Weakening of algorithmic equality of neutrals.
  wk~↑ : ∀ {ρ t u A Γ Δ} ([ρ] : ρ ∷ Δ ⊆ Γ) → ⊢ Δ
      → Γ ⊢ t ~ u ↑ A
      → Δ ⊢ U.wk ρ t ~ U.wk ρ u ↑ U.wk ρ A
  wk~↑ {ρ} [ρ] ⊢Δ (var-refl x₁ x≡y) = var-refl (wkTerm [ρ] ⊢Δ x₁) (PE.cong (wkVar ρ) x≡y)
  wk~↑ ρ ⊢Δ (app-cong {G = G} t~u x) =
    PE.subst (λ x → _ ⊢ _ ~ _ ↑ x) (PE.sym (wk-β G))
             (app-cong (wk~↓ ρ ⊢Δ t~u) (wkConv↑Term ρ ⊢Δ x))
  wk~↑ ρ ⊢Δ (fst-cong p~r) =
    fst-cong (wk~↓ ρ ⊢Δ p~r)
  wk~↑ ρ ⊢Δ (snd-cong {G = G} p~r) =
    PE.subst (λ x → _ ⊢ _ ~ _ ↑ x)
             (PE.sym (wk-β G))
             (snd-cong (wk~↓ ρ ⊢Δ p~r))
  wk~↑ {ρ} {Δ = Δ} [ρ] ⊢Δ (natrec-cong {k} {l} {h} {g} {a₀} {b₀} {F} {G} x x₁ x₂ t~u) =
    PE.subst (λ x → _ ⊢ U.wk ρ (natrec F a₀ h k) ~ _ ↑ x) (PE.sym (wk-β F))
             (natrec-cong (wkConv↑ (lift [ρ]) (⊢Δ ∙ ℕⱼ ⊢Δ) x)
                          (PE.subst (λ x → _ ⊢ _ [conv↑] _ ∷ x) (wk-β F)
                                    (wkConv↑Term [ρ] ⊢Δ x₁))
                          (PE.subst (λ x → Δ ⊢ U.wk ρ h [conv↑] U.wk ρ g ∷ x)
                                    (wk-β-natrec _ F) (wkConv↑Term [ρ] ⊢Δ x₂))
                          (wk~↓ [ρ] ⊢Δ t~u))
  wk~↑ {ρ} {Δ = Δ} [ρ] ⊢Δ (Emptyrec-cong {k} {l} {F} {G} x t~u) =
    Emptyrec-cong (wkConv↑ [ρ] ⊢Δ x) (wk~↓ [ρ] ⊢Δ t~u)

  -- Weakening of algorithmic equality of neutrals in WHNF.
  wk~↓ : ∀ {ρ t u A Γ Δ} ([ρ] : ρ ∷ Δ ⊆ Γ) → ⊢ Δ
      → Γ ⊢ t ~ u ↓ A
      → Δ ⊢ U.wk ρ t ~ U.wk ρ u ↓ U.wk ρ A
  wk~↓ {ρ} [ρ] ⊢Δ ([~] A₁ D whnfA k~l) =
    [~] (U.wk ρ A₁) (wkRed* [ρ] ⊢Δ D) (wkWhnf ρ whnfA) (wk~↑ [ρ] ⊢Δ k~l)

  -- Weakening of algorithmic equality of types.
  wkConv↑ : ∀ {ρ A B Γ Δ} ([ρ] : ρ ∷ Δ ⊆ Γ) → ⊢ Δ
          → Γ ⊢ A [conv↑] B
          → Δ ⊢ U.wk ρ A [conv↑] U.wk ρ B
  wkConv↑ {ρ} [ρ] ⊢Δ ([↑] A′ B′ D D′ whnfA′ whnfB′ A′<>B′) =
    [↑] (U.wk ρ A′) (U.wk ρ B′) (wkRed* [ρ] ⊢Δ D) (wkRed* [ρ] ⊢Δ D′)
        (wkWhnf ρ whnfA′) (wkWhnf ρ whnfB′) (wkConv↓ [ρ] ⊢Δ A′<>B′)

  -- Weakening of algorithmic equality of types in WHNF.
  wkConv↓ : ∀ {ρ A B Γ Δ} ([ρ] : ρ ∷ Δ ⊆ Γ) → ⊢ Δ
         → Γ ⊢ A [conv↓] B
         → Δ ⊢ U.wk ρ A [conv↓] U.wk ρ B
  wkConv↓ ρ ⊢Δ (U-refl x) = U-refl ⊢Δ
  wkConv↓ ρ ⊢Δ (ℕ-refl x) = ℕ-refl ⊢Δ
  wkConv↓ ρ ⊢Δ (Empty-refl x) = Empty-refl ⊢Δ
  wkConv↓ ρ ⊢Δ (Unit-refl x) = Unit-refl ⊢Δ
  wkConv↓ ρ ⊢Δ (ne x) = ne (wk~↓ ρ ⊢Δ x)
  wkConv↓ ρ ⊢Δ (Π-cong x A<>B A<>B₁) =
    let ⊢ρF = wk ρ ⊢Δ x
    in  Π-cong ⊢ρF (wkConv↑ ρ ⊢Δ A<>B) (wkConv↑ (lift ρ) (⊢Δ ∙ ⊢ρF) A<>B₁)
  wkConv↓ ρ ⊢Δ (Σ-cong x A<>B A<>B₁) =
    let ⊢ρF = wk ρ ⊢Δ x
    in  Σ-cong ⊢ρF (wkConv↑ ρ ⊢Δ A<>B) (wkConv↑ (lift ρ) (⊢Δ ∙ ⊢ρF) A<>B₁)

  -- Weakening of algorithmic equality of terms.
  wkConv↑Term : ∀ {ρ t u A Γ Δ} ([ρ] : ρ ∷ Δ ⊆ Γ) → ⊢ Δ
             → Γ ⊢ t [conv↑] u ∷ A
             → Δ ⊢ U.wk ρ t [conv↑] U.wk ρ u ∷ U.wk ρ A
  wkConv↑Term {ρ} [ρ] ⊢Δ ([↑]ₜ B t′ u′ D d d′ whnfB whnft′ whnfu′ t<>u) =
    [↑]ₜ (U.wk ρ B) (U.wk ρ t′) (U.wk ρ u′)
         (wkRed* [ρ] ⊢Δ D) (wkRed*Term [ρ] ⊢Δ d) (wkRed*Term [ρ] ⊢Δ d′)
         (wkWhnf ρ whnfB) (wkWhnf ρ whnft′) (wkWhnf ρ whnfu′)
         (wkConv↓Term [ρ] ⊢Δ t<>u)

  -- Weakening of algorithmic equality of terms in WHNF.
  wkConv↓Term : ∀ {ρ t u A Γ Δ} ([ρ] : ρ ∷ Δ ⊆ Γ) → ⊢ Δ
             → Γ ⊢ t [conv↓] u ∷ A
             → Δ ⊢ U.wk ρ t [conv↓] U.wk ρ u ∷ U.wk ρ A
  wkConv↓Term ρ ⊢Δ (ℕ-ins x) =
    ℕ-ins (wk~↓ ρ ⊢Δ x)
  wkConv↓Term ρ ⊢Δ (Empty-ins x) =
    Empty-ins (wk~↓ ρ ⊢Δ x)
  wkConv↓Term ρ ⊢Δ (Unit-ins x) =
    Unit-ins (wk~↓ ρ ⊢Δ x)
  wkConv↓Term {ρ} [ρ] ⊢Δ (ne-ins t u x x₁) =
    ne-ins (wkTerm [ρ] ⊢Δ t) (wkTerm [ρ] ⊢Δ u) (wkNeutral ρ x) (wk~↓ [ρ] ⊢Δ x₁)
  wkConv↓Term ρ ⊢Δ (univ x x₁ x₂) =
    univ (wkTerm ρ ⊢Δ x) (wkTerm ρ ⊢Δ x₁) (wkConv↓ ρ ⊢Δ x₂)
  wkConv↓Term ρ ⊢Δ (zero-refl x) = zero-refl ⊢Δ
  wkConv↓Term ρ ⊢Δ (suc-cong t<>u) = suc-cong (wkConv↑Term ρ ⊢Δ t<>u)
  wkConv↓Term {ρ} {Δ = Δ} [ρ] ⊢Δ (η-eq {F = F} {G = G} x₁ x₂ y y₁ t<>u) =
    let ⊢F , _ = syntacticΠ (syntacticTerm x₁)
        ⊢ρF = wk [ρ] ⊢Δ ⊢F
    in  η-eq (wkTerm [ρ] ⊢Δ x₁) (wkTerm [ρ] ⊢Δ x₂)
             (wkFunction ρ y) (wkFunction ρ y₁)
             (PE.subst₃ (λ x y z → Δ ∙ U.wk ρ F ⊢ x [conv↑] y ∷ z)
                        (PE.cong₂ _∘_ (PE.sym (wk1-wk≡lift-wk1 _ _)) PE.refl)
                        (PE.cong₂ _∘_ (PE.sym (wk1-wk≡lift-wk1 _ _)) PE.refl)
                        PE.refl
                        (wkConv↑Term (lift [ρ]) (⊢Δ ∙ ⊢ρF) t<>u))
  wkConv↓Term {ρ} [ρ] ⊢Δ (Σ-η {G = G} ⊢p ⊢r pProd rProd fstConv sndConv) =
    Σ-η (wkTerm [ρ] ⊢Δ ⊢p)
        (wkTerm [ρ] ⊢Δ ⊢r)
        (wkProduct ρ pProd)
        (wkProduct ρ rProd)
        (wkConv↑Term [ρ] ⊢Δ fstConv)
        (PE.subst (λ x → _ ⊢ _ [conv↑] _ ∷ x)
                  (wk-β G)
                  (wkConv↑Term [ρ] ⊢Δ sndConv))
  wkConv↓Term {ρ} [ρ] ⊢Δ (η-unit [t] [u] tWhnf uWhnf) =
    η-unit (wkTerm [ρ] ⊢Δ [t]) (wkTerm [ρ] ⊢Δ [u])
           (wkWhnf ρ tWhnf) (wkWhnf ρ uWhnf)


{-# OPTIONS --cubical --no-import-sorts --guardedness --safe #-}

module Cubical.Codata.M.AsLimit.M where

open import Cubical.Codata.M.AsLimit.M.Base public
open import Cubical.Codata.M.AsLimit.M.Properties public


module Issue329c where

private
  infixl 0 D Undeclared
  data D : Set where


module Sessions.Semantics.Runtime {E : Set} (delay : E) where

open import Prelude

open import Relation.Unary hiding (Empty; _∈_)
open import Relation.Unary.PredicateTransformer using (Pt)
open import Relation.Ternary.Separation.Construct.Market
open import Relation.Ternary.Separation.Construct.Product
open import Relation.Ternary.Separation.Morphisms
open import Relation.Ternary.Separation.Monad

open import Sessions.Syntax.Types
open import Sessions.Syntax.Values
open import Sessions.Syntax.Expr

open import Sessions.Semantics.Commands
open import Relation.Ternary.Separation.Monad
open import Relation.Ternary.Separation.Monad.Error
open import Relation.Ternary.Separation.Monad.State

open StateWithErr {C = RCtx} E
open ExceptMonad {A = RCtx} E
open Monads.Monad {{...}}

private
  module _ {C : Set} {{ r : RawSep C }} {u} {{ _ : IsUnitalSep r u }} where
    -- open Monads.Monad (err-monad {A = C}) public
    open Monads using (str) public

module _ where
  data _⇜_ : SType → SType → Pred RCtx 0ℓ where
    emp  : ∀ {α} → (α ⇜ α) ε
    cons : ∀ {a} → ∀[ Val a ✴ (β ⇜ γ) ⇒ ((a ¿ β) ⇜ γ) ]

  _⇝_ = flip _⇜_

  private
    -- It is crucial for type-safety that this is evident
    send-lemma : ∀[ ((a ! β) ⇜ γ) ⇒ Empty (γ ≡ a ! β) ]
    send-lemma emp = emp refl

  record Link (α γ : SType) Φ : Set where
    constructor link
    field
      {β₁ β₂} : SType
      duals   : β₂ ≡ β₁ ⁻¹
      buffers : (α ⇜ β₁ ✴ β₂ ⇝ γ) Φ

  revLink : ∀[ Link α γ ⇒ Link γ α ]
  revLink (link refl buffers) = link (sym dual-involutive) (✴-swap buffers)

  push : ∀[ Val a ✴ γ ⇜ (a ¿ β) ⇒ γ ⇜ β ]
  push (v ×⟨ σ₁ ⟩ emp) = cons (v ×⟨ σ₁ ⟩ emp)
  push (v ×⟨ σ₁ ⟩ cons (w ×⟨ σ₂ ⟩ b)) with ⊎-assoc σ₂ (⊎-comm σ₁)
  ... | _ , σ₃ , σ₄ with push (v ×⟨ ⊎-comm σ₄ ⟩ b)
  ... | b' = cons (w ×⟨ σ₃ ⟩ b')

  pull : ∀[ γ ⇝ (a ¿ β) ⇒ Except E (Val a ✴ γ ⇝ β) ]
  pull emp                  = error delay
  pull (cons (v ×⟨ σ ⟩ vs)) = return (v ×⟨ σ ⟩ vs)

  send-into : ∀[ Val a ✴ Link α (a ! β) ⇒ Link α β ]
  send-into (v ×⟨ σ ⟩ link {x ¿ β₁} refl (px ×⟨ σ₁ ⟩ emp)) rewrite ⊎-id⁻ʳ σ₁ =
    link refl ((push (v ×⟨ σ ⟩ px)) ×⟨ ⊎-idʳ ⟩ emp)

  recvₗ : ∀[ Link (a ¿ β) γ ⇒ Except E (Val a ✴ Link β γ) ]
  recvₗ c@(link refl (bₗ ×⟨ τ ⟩ bᵣ)) = do
    v ×⟨ σ ⟩ l ← mapM (pull bₗ &⟨ τ ⟩ bᵣ) ✴-assocᵣ
    return (v ×⟨ σ ⟩ link refl l)

  recvᵣ : ∀[ Link γ (a ¿ β) ⇒ Except E (Val a ✴ Link γ β) ]
  recvᵣ l = do
    v ×⟨ σ ⟩ l' ← recvₗ (revLink l)
    return (v ×⟨ σ ⟩ revLink l')

  data Recipient : SType → Set where
    rec : Recipient (a ¿ β)
    end : Recipient end

  data Channel : Runtype → Pred RCtx 0ℓ where
    twosided : ∀[ Link α β ⇒ Channel (chan α β) ]
    onesided : ∀[ end ⇝ β  ⇒ Channel (endp β) ]

  Channels' = Allstar Channel
  Channels = uncurry Channels'

  emptyLink : ε[ Link α (α ⁻¹) ]
  emptyLink = link refl (emp ×⟨ ⊎-∙ ⟩ emp)

  emptyChannel : ε[ Channel (chan α (α ⁻¹)) ]
  emptyChannel = twosided (link refl (emp ×⟨ ⊎-∙ ⟩ emp))

  flipChan : ∀ {τ} → ∀[ Channel τ ⇒ Channel (flipped τ) ]
  flipChan (twosided x) = twosided (revLink x)
  flipChan (onesided x) = onesided x

  {- Updating a known endpoint of a channel type -}
  _≔ₑ_ : ∀ {τ} → End α τ → SType → Runtype
  (endp β ∷ [] , divide lr []) ≔ₑ α = chan α β
  (endp β ∷ [] , divide rl []) ≔ₑ α = chan β α
  (         [] , to-left _)    ≔ₑ α = endp α

  onesided-recipient : ∀ {Φ} → (end ⇝ α) Φ → Recipient α
  onesided-recipient emp      = end
  onesided-recipient (cons x) = rec

  {- Receiving on any receiving end of a channel -}
  chan-receive : ∀ {τ} → (e : End (a ¿ α) τ) →
                 ∀[ Channel τ ⇒ Except E (Val a ✴ Channel (e ≔ₑ α)) ]

  chan-receive (._ , divide lr []) (twosided l) = do
    v ×⟨ σ ⟩ l' ← recvₗ l
    return (v ×⟨ σ ⟩ twosided l')

  chan-receive (._ , divide rl []) (twosided l) = do
    v ×⟨ σ ⟩ l' ← recvᵣ l
    return (v ×⟨ σ ⟩ twosided l')

  chan-receive (fst₁ , to-left []) (onesided b) = do
    v ×⟨ σ ⟩ b' ← pull b
    return (v ×⟨ σ ⟩ onesided b')

  {- Sending on any sending end of a channel -}
  chan-send : ∀ {τ} → (e : End (a ! α) τ) →
              ∀[ Channel τ ⇒ Val a ─✴ Channel (e ≔ₑ α) ]

  app (chan-send (_ , divide lr []) (twosided l)) v σ =
    let l' = send-into (v ×⟨ ⊎-comm σ ⟩ revLink l)
    in twosided (revLink l')

  app (chan-send (_ , divide rl []) (twosided l)) v σ =
    let l' = send-into (v ×⟨ ⊎-comm σ ⟩ l)
    in twosided l'

  -- cannot be onesided
  app (chan-send (_ , to-left []  ) (onesided b)) v σ with onesided-recipient b
  ... | ()


{-# OPTIONS --safe -WnoSafeFlagNoCoverageCheck #-}

open import Agda.Builtin.Bool
open import Agda.Builtin.Equality

data ⊥ : Set where

{-# NON_COVERING #-}

f : ∀ b → b ≡ true → ⊥
f false ()

bad : ⊥
bad = f true refl


-- New NO_POSITIVITY_CHECK pragma for data definitions and mutual
-- blocks

-- Skipping a single data definition in an abstract block.
abstract
  {-# NO_POSITIVITY_CHECK #-}
  data D : Set where
    lam : (D → D) → D


{- Byzantine Fault Tolerant Consensus Verification in Agda, version 0.9.

   Copyright (c) 2021, Oracle and/or its affiliates.
   Licensed under the Universal Permissive License v 1.0 as shown at https://opensource.oracle.com/licenses/upl
-}

module Dijkstra.EitherD.Syntax where

open import Dijkstra.EitherD
open import Dijkstra.EitherLike
open import Dijkstra.Syntax
open import Haskell.Prelude

private
  variable
    E     : Set
    A B C : Set

-- From this instance declaration, we get _<$>_, pure, and _<*>_ also.
instance
  Monad-EitherD : ∀ {E : Set} → Monad (EitherD E)
  Monad.return Monad-EitherD = EitherD-return
  Monad._>>=_  Monad-EitherD = EitherD-bind

-- These instance declarations give us variant conditional operations that we
-- can define to play nice with `EitherD-weakestPre`

instance
  EitherD-MonadIfD : MonadIfD{ℓ₃ = ℓ0} (EitherD E)
  MonadIfD.monad EitherD-MonadIfD = Monad-EitherD
  MonadIfD.ifD‖  EitherD-MonadIfD = EitherD-if

  EitherD-MonadMaybeD : MonadMaybeD (EitherD E)
  MonadMaybeD.monad  EitherD-MonadMaybeD = Monad-EitherD
  MonadMaybeD.maybeD EitherD-MonadMaybeD = EitherD-maybe

  EitherD-MonadEitherD : MonadEitherD (EitherD E)
  MonadEitherD.monad    EitherD-MonadEitherD = Monad-EitherD
  MonadEitherD.eitherD  EitherD-MonadEitherD = EitherD-either

-- `EitherD` is Either-like
instance
  EitherD-EitherLike : EitherLike EitherD
  EitherLike.fromEither EitherD-EitherLike (Left  a) = EitherD-bail a
  EitherLike.fromEither EitherD-EitherLike (Right b) = EitherD-return b

  EitherLike.toEither   EitherD-EitherLike = EitherD-run


module Rec2 where

  open import Data.Nat
  open import Rec1

  x : ℕ
  x = 42

  z : ℕ
  z = y


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

open import Definition.Typed.EqualityRelation

module Definition.LogicalRelation.Substitution.Introductions.Pi {{eqrel : EqRelSet}} where
open EqRelSet {{...}}

open import Definition.Untyped as U hiding (wk)
open import Definition.Untyped.Properties
open import Definition.Typed
open import Definition.Typed.Weakening using (_∷_⊆_)
open import Definition.Typed.Properties
open import Definition.LogicalRelation
open import Definition.LogicalRelation.ShapeView
open import Definition.LogicalRelation.Weakening
open import Definition.LogicalRelation.Irrelevance
open import Definition.LogicalRelation.Properties
open import Definition.LogicalRelation.Substitution
open import Definition.LogicalRelation.Substitution.Weakening
open import Definition.LogicalRelation.Substitution.Properties
import Definition.LogicalRelation.Substitution.Irrelevance as S
open import Definition.LogicalRelation.Substitution.Introductions.Universe

open import Tools.Nat
open import Tools.Product
import Tools.PropositionalEquality as PE

-- Validity of Π.
Πᵛ : ∀ {F G Γ l}
     ([Γ] : ⊩ᵛ Γ)
     ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ])
   → Γ ∙ F ⊩ᵛ⟨ l ⟩ G / ([Γ] ∙″ [F])
   → Γ ⊩ᵛ⟨ l ⟩ Π F ▹ G / [Γ]
Πᵛ {F} {G} {Γ} {l} [Γ] [F] [G] {Δ = Δ} {σ = σ} ⊢Δ [σ] =
  let [F]σ {σ′} [σ′] = [F] {σ = σ′} ⊢Δ [σ′]
      [σF] = proj₁ ([F]σ [σ])
      ⊢F {σ′} [σ′] = escape (proj₁ ([F]σ {σ′} [σ′]))
      ⊢F≡F = escapeEq [σF] (reflEq [σF])
      [G]σ {σ′} [σ′] = [G] {σ = liftSubst σ′} (⊢Δ ∙ ⊢F [σ′])
                           (liftSubstS {F = F} [Γ] ⊢Δ [F] [σ′])
      ⊢G {σ′} [σ′] = escape (proj₁ ([G]σ {σ′} [σ′]))
      ⊢G≡G = escapeEq (proj₁ ([G]σ [σ])) (reflEq (proj₁ ([G]σ [σ])))
      ⊢ΠF▹G = Πⱼ ⊢F [σ] ▹ ⊢G [σ]
      [G]a : ∀ {ρ Δ₁} a ([ρ] : ρ ∷ Δ₁ ⊆ Δ) (⊢Δ₁ : ⊢ Δ₁)
             ([a] : Δ₁ ⊩⟨ l ⟩ a ∷ subst (ρ •ₛ σ) F
                / proj₁ ([F] ⊢Δ₁ (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ])))
           → Σω₀ (Δ₁ ⊩⟨ l ⟩ subst (consSubst (ρ •ₛ σ) a) G)
               (λ [Aσ] →
               {σ′ : Nat → Term} →
               (Σω₂ (Δ₁ ⊩ˢ tail σ′ ∷ Γ / [Γ] / ⊢Δ₁)
               (λ [tailσ] →
                  Δ₁ ⊩⟨ l ⟩ head σ′ ∷ subst (tail σ′) F / proj₁ ([F] ⊢Δ₁ [tailσ]))) →
               Δ₁ ⊩ˢ consSubst (ρ •ₛ σ) a ≡ σ′ ∷ Γ ∙ F /
               [Γ] ∙″ [F] / ⊢Δ₁ /
               consSubstS {t = a} {A = F} [Γ] ⊢Δ₁ (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]) [F]
               [a] →
               Δ₁ ⊩⟨ l ⟩ subst (consSubst (ρ •ₛ σ) a) G ≡
               subst σ′ G / [Aσ])
      [G]a {ρ} a [ρ] ⊢Δ₁ [a] = ([G] {σ = consSubst (ρ •ₛ σ) a} ⊢Δ₁
                              (consSubstS {t = a} {A = F} [Γ] ⊢Δ₁
                                          (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ])
                                          [F] [a]))
      [G]a′ : ∀ {ρ Δ₁} a ([ρ] : ρ ∷ Δ₁ ⊆ Δ) (⊢Δ₁ : ⊢ Δ₁)
            → Δ₁ ⊩⟨ l ⟩ a ∷ subst (ρ •ₛ σ) F
                 / proj₁ ([F] ⊢Δ₁ (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]))
            → Δ₁ ⊩⟨ l ⟩ U.wk (lift ρ) (subst (liftSubst σ) G) [ a ]
      [G]a′ a ρ ⊢Δ₁ [a] = irrelevance′ (PE.sym (singleSubstWkComp a σ G))
                                   (proj₁ ([G]a a ρ ⊢Δ₁ [a]))
  in Πᵣ′ (subst σ F) (subst (liftSubst σ) G)
         (idRed:*: ⊢ΠF▹G) (⊢F [σ]) (⊢G [σ]) (≅-Π-cong (⊢F [σ]) ⊢F≡F ⊢G≡G)
         (λ ρ ⊢Δ₁ → wk ρ ⊢Δ₁ [σF])
         (λ {ρ} {Δ₁} {a} [ρ] ⊢Δ₁ [a] →
            let [a]′ = irrelevanceTerm′
                         (wk-subst F) (wk [ρ] ⊢Δ₁ [σF])
                         (proj₁ ([F] ⊢Δ₁ (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]))) [a]
            in  [G]a′ a [ρ] ⊢Δ₁ [a]′)
         (λ {ρ} {Δ₁} {a} {b} [ρ] ⊢Δ₁ [a] [b] [a≡b] →
            let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]
                [a]′ = irrelevanceTerm′
                         (wk-subst F) (wk [ρ] ⊢Δ₁ [σF])
                         (proj₁ ([F] ⊢Δ₁ [ρσ])) [a]
                [b]′ = irrelevanceTerm′
                         (wk-subst F) (wk [ρ] ⊢Δ₁ [σF])
                         (proj₁ ([F] ⊢Δ₁ [ρσ])) [b]
                [a≡b]′ = irrelevanceEqTerm′
                           (wk-subst F) (wk [ρ] ⊢Δ₁ [σF])
                           (proj₁ ([F] ⊢Δ₁ [ρσ])) [a≡b]
            in  irrelevanceEq″
                  (PE.sym (singleSubstWkComp a σ G))
                  (PE.sym (singleSubstWkComp b σ G))
                  (proj₁ ([G]a a [ρ] ⊢Δ₁ [a]′))
                  ([G]a′ a [ρ] ⊢Δ₁ [a]′)
                  (proj₂ ([G]a a [ρ] ⊢Δ₁ [a]′)
                         ([ρσ] , [b]′)
                         (reflSubst [Γ] ⊢Δ₁ [ρσ] , [a≡b]′)))
  ,  (λ {σ′} [σ′] [σ≡σ′] →
        let var0 = var (⊢Δ ∙ ⊢F [σ])
                       (PE.subst (λ x → 0 ∷ x ∈ (Δ ∙ subst σ F))
                                 (wk-subst F) here)
            [wk1σ] = wk1SubstS [Γ] ⊢Δ (⊢F [σ]) [σ]
            [wk1σ′] = wk1SubstS [Γ] ⊢Δ (⊢F [σ]) [σ′]
            [wk1σ≡wk1σ′] = wk1SubstSEq [Γ] ⊢Δ (⊢F [σ]) [σ] [σ≡σ′]
            [F][wk1σ] = proj₁ ([F] (⊢Δ ∙ ⊢F [σ]) [wk1σ])
            [F][wk1σ′] = proj₁ ([F] (⊢Δ ∙ ⊢F [σ]) [wk1σ′])
            var0′ = conv var0
                         (≅-eq (escapeEq [F][wk1σ]
                                             (proj₂ ([F] (⊢Δ ∙ ⊢F [σ]) [wk1σ])
                                                    [wk1σ′] [wk1σ≡wk1σ′])))
        in  Π₌ _ _ (id (Πⱼ ⊢F [σ′] ▹ ⊢G [σ′]))
               (≅-Π-cong (⊢F [σ])
                       (escapeEq (proj₁ ([F] ⊢Δ [σ]))
                                    (proj₂ ([F] ⊢Δ [σ]) [σ′] [σ≡σ′]))
                       (escapeEq (proj₁ ([G]σ [σ])) (proj₂ ([G]σ [σ])
                         ([wk1σ′] , neuTerm [F][wk1σ′] (var 0) var0′ (~-var var0′))
                         ([wk1σ≡wk1σ′] , neuEqTerm [F][wk1σ]
                           (var 0) (var 0) var0 var0 (~-var var0)))))
               (λ ρ ⊢Δ₁ → wkEq ρ ⊢Δ₁ [σF] (proj₂ ([F] ⊢Δ [σ]) [σ′] [σ≡σ′]))
               (λ {ρ} {Δ₁} {a} [ρ] ⊢Δ₁ [a] →
                  let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]
                      [ρσ′] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ′]
                      [a]′ = irrelevanceTerm′ (wk-subst F) (wk [ρ] ⊢Δ₁ [σF])
                                 (proj₁ ([F] ⊢Δ₁ [ρσ])) [a]
                      [a]″ = convTerm₁ (proj₁ ([F] ⊢Δ₁ [ρσ]))
                                        (proj₁ ([F] ⊢Δ₁ [ρσ′]))
                                        (proj₂ ([F] ⊢Δ₁ [ρσ]) [ρσ′]
                                               (wkSubstSEq [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ] [σ≡σ′]))
                                        [a]′
                      [ρσa≡ρσ′a] = consSubstSEq {t = a} {A = F} [Γ] ⊢Δ₁
                                                (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ])
                                                (wkSubstSEq [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ] [σ≡σ′])
                                                [F] [a]′
                  in  irrelevanceEq″ (PE.sym (singleSubstWkComp a σ G))
                                      (PE.sym (singleSubstWkComp a σ′ G))
                                      (proj₁ ([G]a a [ρ] ⊢Δ₁ [a]′))
                                      ([G]a′ a [ρ] ⊢Δ₁ [a]′)
                                      (proj₂ ([G]a a [ρ] ⊢Δ₁ [a]′)
                                             (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ′] , [a]″)
                                             [ρσa≡ρσ′a])))

-- Validity of Π-congurence.
Π-congᵛ : ∀ {F G H E Γ l}
          ([Γ] : ⊩ᵛ Γ)
          ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ])
          ([G] : Γ ∙ F ⊩ᵛ⟨ l ⟩ G / ([Γ] ∙″ [F]))
          ([H] : Γ ⊩ᵛ⟨ l ⟩ H / [Γ])
          ([E] : Γ ∙ H ⊩ᵛ⟨ l ⟩ E / ([Γ] ∙″ [H]))
          ([F≡H] : Γ ⊩ᵛ⟨ l ⟩ F ≡ H / [Γ] / [F])
          ([G≡E] : Γ ∙ F ⊩ᵛ⟨ l ⟩ G ≡ E / [Γ] ∙″ [F] / [G])
        → Γ ⊩ᵛ⟨ l ⟩ Π F ▹ G ≡ Π H ▹ E / [Γ] / Πᵛ {F} {G} [Γ] [F] [G]
Π-congᵛ {F} {G} {H} {E} [Γ] [F] [G] [H] [E] [F≡H] [G≡E] {σ = σ} ⊢Δ [σ] =
  let [ΠFG] = Πᵛ {F} {G} [Γ] [F] [G]
      [σΠFG] = proj₁ ([ΠFG] ⊢Δ [σ])
      Πᵣ F′ G′ D′ ⊢F′ ⊢G′ A≡A′ [F]′ [G]′ G-ext′ = extractMaybeEmbΠ (Π-elim [σΠFG])
      [σF] = proj₁ ([F] ⊢Δ [σ])
      ⊢σF = escape [σF]
      [σG] = proj₁ ([G] (⊢Δ ∙ ⊢σF) (liftSubstS {F = F} [Γ] ⊢Δ [F] [σ]))
      ⊢σH = escape (proj₁ ([H] ⊢Δ [σ]))
      ⊢σE = escape (proj₁ ([E] (⊢Δ ∙ ⊢σH) (liftSubstS {F = H} [Γ] ⊢Δ [H] [σ])))
      ⊢σF≡σH = escapeEq [σF] ([F≡H] ⊢Δ [σ])
      ⊢σG≡σE = escapeEq [σG] ([G≡E] (⊢Δ ∙ ⊢σF) (liftSubstS {F = F} [Γ] ⊢Δ [F] [σ]))
  in  Π₌ (subst σ H)
         (subst (liftSubst σ) E)
         (id (Πⱼ ⊢σH ▹ ⊢σE))
         (≅-Π-cong ⊢σF ⊢σF≡σH ⊢σG≡σE)
         (λ ρ ⊢Δ₁ → let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ ρ [σ]
                    in  irrelevanceEq″ (PE.sym (wk-subst F))
                                        (PE.sym (wk-subst H))
                                        (proj₁ ([F] ⊢Δ₁ [ρσ]))
                                        ([F]′ ρ ⊢Δ₁)
                                        ([F≡H] ⊢Δ₁ [ρσ]))
         (λ {ρ} {Δ} {a} [ρ] ⊢Δ₁ [a] →
            let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]
                [a]′ = irrelevanceTerm′ (wk-subst F)
                                        ([F]′ [ρ] ⊢Δ₁)
                                        (proj₁ ([F] ⊢Δ₁ [ρσ])) [a]
                [aρσ] = consSubstS {t = a} {A = F} [Γ] ⊢Δ₁ [ρσ] [F] [a]′
            in  irrelevanceEq″ (PE.sym (singleSubstWkComp a σ G))
                                (PE.sym (singleSubstWkComp a σ E))
                                (proj₁ ([G] ⊢Δ₁ [aρσ]))
                                ([G]′ [ρ] ⊢Δ₁ [a])
                                ([G≡E] ⊢Δ₁ [aρσ]))

-- Validity of Π as a term.
Πᵗᵛ : ∀ {F G Γ} ([Γ] : ⊩ᵛ Γ)
      ([F] : Γ ⊩ᵛ⟨ ¹ ⟩ F / [Γ])
      ([U] : Γ ∙ F ⊩ᵛ⟨ ¹ ⟩ U / ([Γ] ∙″ [F]))
    → Γ ⊩ᵛ⟨ ¹ ⟩ F ∷ U / [Γ] / Uᵛ [Γ]
    → Γ ∙ F ⊩ᵛ⟨ ¹ ⟩ G ∷ U / [Γ] ∙″ [F] / (λ {Δ} {σ} → [U] {Δ} {σ})
    → Γ ⊩ᵛ⟨ ¹ ⟩ Π F ▹ G ∷ U / [Γ] / Uᵛ [Γ]
Πᵗᵛ {F} {G} {Γ} [Γ] [F] [U] [Fₜ] [Gₜ] {Δ = Δ} {σ = σ} ⊢Δ [σ] =
  let [liftσ] = liftSubstS {F = F} [Γ] ⊢Δ [F] [σ]
      ⊢F = escape (proj₁ ([F] ⊢Δ [σ]))
      ⊢Fₜ = escapeTerm (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([Fₜ] ⊢Δ [σ]))
      ⊢F≡Fₜ = escapeTermEq (Uᵣ′ ⁰ 0<1 ⊢Δ)
                               (reflEqTerm (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([Fₜ] ⊢Δ [σ])))
      ⊢Gₜ = escapeTerm (proj₁ ([U] (⊢Δ ∙ ⊢F) [liftσ]))
                           (proj₁ ([Gₜ] (⊢Δ ∙ ⊢F) [liftσ]))
      ⊢G≡Gₜ = escapeTermEq (proj₁ ([U] (⊢Δ ∙ ⊢F) [liftσ]))
                               (reflEqTerm (proj₁ ([U] (⊢Δ ∙ ⊢F) [liftσ]))
                                           (proj₁ ([Gₜ] (⊢Δ ∙ ⊢F) [liftσ])))
      [F]₀ = univᵛ {F} [Γ] (Uᵛ [Γ]) [Fₜ]
      [Gₜ]′ = S.irrelevanceTerm {A = U} {t = G}
                                (_∙″_ {A = F} [Γ] [F]) (_∙″_ {A = F} [Γ] [F]₀)
                                (λ {Δ} {σ} → [U] {Δ} {σ})
                                (λ {Δ} {σ} → Uᵛ (_∙″_ {A = F} [Γ] [F]₀) {Δ} {σ})
                                [Gₜ]
      [G]₀ = univᵛ {G} (_∙″_ {A = F} [Γ] [F]₀)
                   (λ {Δ} {σ} → Uᵛ (_∙″_ {A = F} [Γ] [F]₀) {Δ} {σ})
                   (λ {Δ} {σ} → [Gₜ]′ {Δ} {σ})
      [ΠFG] = (Πᵛ {F} {G} [Γ] [F]₀ [G]₀) ⊢Δ [σ]
  in  Uₜ (Π subst σ F ▹ subst (liftSubst σ) G) (idRedTerm:*: (Πⱼ ⊢Fₜ ▹ ⊢Gₜ))
         Πₙ (≅ₜ-Π-cong ⊢F ⊢F≡Fₜ ⊢G≡Gₜ) (proj₁ [ΠFG])
  ,   (λ {σ′} [σ′] [σ≡σ′] →
         let [liftσ′] = liftSubstS {F = F} [Γ] ⊢Δ [F] [σ′]
             [wk1σ] = wk1SubstS [Γ] ⊢Δ ⊢F [σ]
             [wk1σ′] = wk1SubstS [Γ] ⊢Δ ⊢F [σ′]
             var0 = conv (var (⊢Δ ∙ ⊢F)
                         (PE.subst (λ x → 0 ∷ x ∈ (Δ ∙ subst σ F))
                                   (wk-subst F) here))
                    (≅-eq (escapeEq (proj₁ ([F] (⊢Δ ∙ ⊢F) [wk1σ]))
                                        (proj₂ ([F] (⊢Δ ∙ ⊢F) [wk1σ]) [wk1σ′]
                                               (wk1SubstSEq [Γ] ⊢Δ ⊢F [σ] [σ≡σ′]))))
             [liftσ′]′ = [wk1σ′]
                       , neuTerm (proj₁ ([F] (⊢Δ ∙ ⊢F) [wk1σ′])) (var 0)
                                 var0 (~-var var0)
             ⊢F′ = escape (proj₁ ([F] ⊢Δ [σ′]))
             ⊢Fₜ′ = escapeTerm (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([Fₜ] ⊢Δ [σ′]))
             ⊢Gₜ′ = escapeTerm (proj₁ ([U] (⊢Δ ∙ ⊢F′) [liftσ′]))
                                  (proj₁ ([Gₜ] (⊢Δ ∙ ⊢F′) [liftσ′]))
             ⊢F≡F′ = escapeTermEq (Uᵣ′ ⁰ 0<1 ⊢Δ)
                                     (proj₂ ([Fₜ] ⊢Δ [σ]) [σ′] [σ≡σ′])
             ⊢G≡G′ = escapeTermEq (proj₁ ([U] (⊢Δ ∙ ⊢F) [liftσ]))
                                     (proj₂ ([Gₜ] (⊢Δ ∙ ⊢F) [liftσ]) [liftσ′]′
                                            (liftSubstSEq {F = F} [Γ] ⊢Δ [F] [σ] [σ≡σ′]))
             [ΠFG]′ = (Πᵛ {F} {G} [Γ] [F]₀ [G]₀) ⊢Δ [σ′]
         in  Uₜ₌ (Π subst σ F ▹ subst (liftSubst σ) G)
                 (Π subst σ′ F ▹ subst (liftSubst σ′) G)
                 (idRedTerm:*: (Πⱼ ⊢Fₜ ▹ ⊢Gₜ))
                 (idRedTerm:*: (Πⱼ ⊢Fₜ′ ▹ ⊢Gₜ′))
                 Πₙ Πₙ (≅ₜ-Π-cong ⊢F ⊢F≡F′ ⊢G≡G′)
                 (proj₁ [ΠFG]) (proj₁ [ΠFG]′) (proj₂ [ΠFG] [σ′] [σ≡σ′]))

-- Validity of Π-congurence as a term equality.
Π-congᵗᵛ : ∀ {F G H E Γ}
           ([Γ] : ⊩ᵛ Γ)
           ([F] : Γ ⊩ᵛ⟨ ¹ ⟩ F / [Γ])
           ([H] : Γ ⊩ᵛ⟨ ¹ ⟩ H / [Γ])
           ([UF] : Γ ∙ F ⊩ᵛ⟨ ¹ ⟩ U / ([Γ] ∙″ [F]))
           ([UH] : Γ ∙ H ⊩ᵛ⟨ ¹ ⟩ U / ([Γ] ∙″ [H]))
           ([F]ₜ : Γ ⊩ᵛ⟨ ¹ ⟩ F ∷ U / [Γ] / Uᵛ [Γ])
           ([G]ₜ : Γ ∙ F ⊩ᵛ⟨ ¹ ⟩ G ∷ U / [Γ] ∙″ [F]
                                / (λ {Δ} {σ} → [UF] {Δ} {σ}))
           ([H]ₜ : Γ ⊩ᵛ⟨ ¹ ⟩ H ∷ U / [Γ] / Uᵛ [Γ])
           ([E]ₜ : Γ ∙ H ⊩ᵛ⟨ ¹ ⟩ E ∷ U / [Γ] ∙″ [H]
                                / (λ {Δ} {σ} → [UH] {Δ} {σ}))
           ([F≡H]ₜ : Γ ⊩ᵛ⟨ ¹ ⟩ F ≡ H ∷ U / [Γ] / Uᵛ [Γ])
           ([G≡E]ₜ : Γ ∙ F ⊩ᵛ⟨ ¹ ⟩ G ≡ E ∷ U / [Γ] ∙″ [F]
                                  / (λ {Δ} {σ} → [UF] {Δ} {σ}))
         → Γ ⊩ᵛ⟨ ¹ ⟩ Π F ▹ G ≡ Π H ▹ E ∷ U / [Γ] / Uᵛ [Γ]
Π-congᵗᵛ {F} {G} {H} {E}
         [Γ] [F] [H] [UF] [UH] [F]ₜ [G]ₜ [H]ₜ [E]ₜ [F≡H]ₜ [G≡E]ₜ {Δ} {σ} ⊢Δ [σ] =
  let ⊢F = escape (proj₁ ([F] ⊢Δ [σ]))
      ⊢H = escape (proj₁ ([H] ⊢Δ [σ]))
      [liftFσ] = liftSubstS {F = F} [Γ] ⊢Δ [F] [σ]
      [liftHσ] = liftSubstS {F = H} [Γ] ⊢Δ [H] [σ]
      [F]ᵤ = univᵛ {F} [Γ] (Uᵛ [Γ]) [F]ₜ
      [G]ᵤ₁ = univᵛ {G} {l′ = ⁰} (_∙″_ {A = F} [Γ] [F])
                    (λ {Δ} {σ} → [UF] {Δ} {σ}) [G]ₜ
      [G]ᵤ = S.irrelevance {A = G} (_∙″_ {A = F} [Γ] [F])
                           (_∙″_ {A = F} [Γ] [F]ᵤ) [G]ᵤ₁
      [H]ᵤ = univᵛ {H} [Γ] (Uᵛ [Γ]) [H]ₜ
      [E]ᵤ = S.irrelevance {A = E} (_∙″_ {A = H} [Γ] [H]) (_∙″_ {A = H} [Γ] [H]ᵤ)
                           (univᵛ {E} {l′ = ⁰} (_∙″_ {A = H} [Γ] [H])
                                  (λ {Δ} {σ} → [UH] {Δ} {σ}) [E]ₜ)
      [F≡H]ᵤ = univEqᵛ {F} {H} [Γ] (Uᵛ [Γ]) [F]ᵤ [F≡H]ₜ
      [G≡E]ᵤ = S.irrelevanceEq {A = G} {B = E} (_∙″_ {A = F} [Γ] [F])
                               (_∙″_ {A = F} [Γ] [F]ᵤ) [G]ᵤ₁ [G]ᵤ
                 (univEqᵛ {G} {E} (_∙″_ {A = F} [Γ] [F])
                          (λ {Δ} {σ} → [UF] {Δ} {σ}) [G]ᵤ₁ [G≡E]ₜ)
      ΠFGₜ = Πⱼ escapeTerm {l = ¹} (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([F]ₜ ⊢Δ [σ]))
             ▹  escapeTerm (proj₁ ([UF] (⊢Δ ∙ ⊢F) [liftFσ]))
                           (proj₁ ([G]ₜ (⊢Δ ∙ ⊢F) [liftFσ]))
      ΠHEₜ = Πⱼ escapeTerm {l = ¹} (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([H]ₜ ⊢Δ [σ]))
             ▹  escapeTerm (proj₁ ([UH] (⊢Δ ∙ ⊢H) [liftHσ]))
                           (proj₁ ([E]ₜ (⊢Δ ∙ ⊢H) [liftHσ]))
  in  Uₜ₌ (Π subst σ F ▹ subst (liftSubst σ) G)
          (Π subst σ H ▹ subst (liftSubst σ) E)
          (idRedTerm:*: ΠFGₜ) (idRedTerm:*: ΠHEₜ)
          Πₙ Πₙ
          (≅ₜ-Π-cong ⊢F (escapeTermEq (Uᵣ′ ⁰ 0<1 ⊢Δ) ([F≡H]ₜ ⊢Δ [σ]))
                        (escapeTermEq (proj₁ ([UF] (⊢Δ ∙ ⊢F) [liftFσ]))
                                          ([G≡E]ₜ (⊢Δ ∙ ⊢F) [liftFσ])))
          (proj₁ (Πᵛ {F} {G} [Γ] [F]ᵤ [G]ᵤ ⊢Δ [σ]))
          (proj₁ (Πᵛ {H} {E} [Γ] [H]ᵤ [E]ᵤ ⊢Δ [σ]))
          (Π-congᵛ {F} {G} {H} {E} [Γ] [F]ᵤ [G]ᵤ [H]ᵤ [E]ᵤ [F≡H]ᵤ [G≡E]ᵤ ⊢Δ [σ])

-- Validity of non-dependent function types.
▹▹ᵛ : ∀ {F G Γ l}
      ([Γ] : ⊩ᵛ Γ)
      ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ])
    → Γ ⊩ᵛ⟨ l ⟩ G / [Γ]
    → Γ ⊩ᵛ⟨ l ⟩ F ▹▹ G / [Γ]
▹▹ᵛ {F} {G} [Γ] [F] [G] =
  Πᵛ {F} {wk1 G} [Γ] [F] (wk1ᵛ {G} {F} [Γ] [F] [G])

-- Validity of non-dependent function type congurence.
▹▹-congᵛ : ∀ {F F′ G G′ Γ l}
           ([Γ] : ⊩ᵛ Γ)
           ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ])
           ([F′] : Γ ⊩ᵛ⟨ l ⟩ F′ / [Γ])
           ([F≡F′] : Γ ⊩ᵛ⟨ l ⟩ F ≡ F′ / [Γ] / [F])
           ([G] : Γ ⊩ᵛ⟨ l ⟩ G / [Γ])
           ([G′] : Γ ⊩ᵛ⟨ l ⟩ G′ / [Γ])
           ([G≡G′] : Γ ⊩ᵛ⟨ l ⟩ G ≡ G′ / [Γ] / [G])
         → Γ ⊩ᵛ⟨ l ⟩ F ▹▹ G ≡ F′ ▹▹ G′ / [Γ] / ▹▹ᵛ {F} {G} [Γ] [F] [G]
▹▹-congᵛ {F} {F′} {G} {G′} [Γ] [F] [F′] [F≡F′] [G] [G′] [G≡G′] =
  Π-congᵛ {F} {wk1 G} {F′} {wk1 G′} [Γ]
          [F] (wk1ᵛ {G} {F} [Γ] [F] [G])
          [F′] (wk1ᵛ {G′} {F′} [Γ] [F′] [G′])
          [F≡F′] (wk1Eqᵛ {G} {G′} {F} [Γ] [F] [G] [G≡G′])


{- Byzantine Fault Tolerant Consensus Verification in Agda, version 0.9.

   Copyright (c) 2020, 2021, Oracle and/or its affiliates.
   Licensed under the Universal Permissive License v 1.0 as shown at https://opensource.oracle.com/licenses/upl
-}

-- This module provides functionality for proving properties about
-- programs written using this RWS monad. The main definitions are:
-- -  RWS-weakestPre, a large elimination that, given an RWS program and a
--    post condition for the program, produces the weakest precondition needed
--    to satisfy that post condition. Branches in code using the constructors
--    `RWS-if` and friends are translated into products, with each component of
--    the product corresponding to a possible branch taken.
-- -  RWS-Contract is the type of proofs that, given a stateful computation and
--    a post condition, the weakest precondition suffices to prove that post
--    condition.
-- -  RWS-contract proves RWS-Contract, i.e., for every stateful computation
--    `m` and post condition `P`, given a proof over a pre-state `pre` the
--    weakest precondition for `P` holds, then postcondition `P` holds for the
--    post-state obtained from running `m` in state `pre`.

module Dijkstra.RWS where

open import Agda.Builtin.Equality using (_≡_; refl)
open import Data.Product using (_×_; _,_; proj₁; proj₂)
open import Haskell.Modules.RWS
open import Haskell.Prelude

private
  variable
    Ev Wr St : Set
    A B C    : Set

-- Preconditions are predicates over environments and prestates.
RWS-Pre : (Ev St : Set) → Set₁
RWS-Pre Ev St = (ev : Ev) (pre : St) → Set

-- Postconditions are predicates over a result, poststate, and list of outputs.
RWS-Post : (Wr St A : Set) → Set₁
RWS-Post Wr St A = (x : A) (post : St) (outs : List Wr) → Set

RWS-Post-⇒ : (P Q : RWS-Post Wr St A) → Set
RWS-Post-⇒ P Q = ∀ r st outs → P r st outs → Q r st outs

-- RWS-weakestPre computes a predicate transformer: it maps a RWS
-- computation `m` and desired postcondition `Post` to the weakest precondition
-- needed to prove `P` holds after running `m`.
RWS-PredTrans : (Ev Wr St A : Set) → Set₁
RWS-PredTrans Ev Wr St A = RWS-Post Wr St A → RWS-Pre Ev St

-- When RWS computations are sequenced, e.g., `RWS-bind m λ x → f x`,
-- outputs are concatenated. The postcondition desired for the above sequence
-- becomes a postcondition for `f x` in which the outputs of `m` are prepended
-- to the outputs of `f x`.
RWS-Post++ : ∀ {Wr St A} → RWS-Post Wr St A → List Wr → RWS-Post Wr St A
RWS-Post++ P outs x post outs₁ = P x post (outs ++ outs₁)

-- Consider again the sequence `RWS-bind m₁ λ x → f x`. We also translate a
-- postcondition `P` for the sequence into a postcondition for `m` ---
-- specifically, the post condition we want for `m` is that the weakest
-- precondition for `RWS-Post++ P outs` holds, where `outs` are the outputs of
-- `m`.
RWS-weakestPre-bindPost  : (ev : Ev) (f : A → RWS Ev Wr St B) → RWS-Post Wr St B → RWS-Post Wr St A
RWS-weakestPre-ebindPost : (ev : Ev) (f : A → RWS Ev Wr St (Either C B)) → RWS-Post Wr St (Either C B) → RWS-Post Wr St (Either C A)

RWS-weakestPre : (m : RWS Ev Wr St A) → RWS-PredTrans Ev Wr St A
RWS-weakestPre (RWS-return x) P ev pre = P x pre []
RWS-weakestPre (RWS-bind m f) P ev pre =
  RWS-weakestPre m (RWS-weakestPre-bindPost ev f P) ev pre
RWS-weakestPre (RWS-gets f) P ev pre = P (f pre) pre []
RWS-weakestPre (RWS-put post) P ev pre = P unit post []
RWS-weakestPre RWS-ask P ev pre = P ev pre []
RWS-weakestPre (RWS-tell outs) P ev pre = P unit pre outs
RWS-weakestPre (RWS-if (clause (b ≔ c) gs)) P ev pre =
  (toBool b ≡ true → RWS-weakestPre c P ev pre)
  × (toBool b ≡ false → RWS-weakestPre (RWS-if gs) P ev pre)
RWS-weakestPre (RWS-if (otherwise≔ c)) P ev pre =
  RWS-weakestPre c P ev pre
RWS-weakestPre (RWS-either f₁ f₂ e) P ev pre =
    (∀ x → (e ≡ Left x) →
      RWS-weakestPre (f₁ x) P ev pre)
  × (∀ y → (e ≡ Right y) →
       RWS-weakestPre (f₂ y) P ev pre)
RWS-weakestPre (RWS-ebind m f) P ev pre =
  RWS-weakestPre m (RWS-weakestPre-ebindPost ev f P) ev pre
RWS-weakestPre (RWS-maybe f₁ f₂ m) P ev pre =
  (m ≡ nothing → RWS-weakestPre f₁ P ev pre)
  × (∀ j → m ≡ just j → RWS-weakestPre (f₂ j) P ev pre)

RWS-weakestPre-ebindPost ev f Post (Left r) post outs =
  Post (Left r) post outs
RWS-weakestPre-ebindPost ev f Post (Right r) post outs =
  ∀ c → c ≡ r → RWS-weakestPre (f c) (RWS-Post++ Post outs) ev post

RWS-weakestPre-bindPost ev f Post x post outs =
  ∀ r → r ≡ x → RWS-weakestPre (f r) (RWS-Post++ Post outs) ev post

-- The post condition `P` holds for `m` with environment `ev` and prestate `pre`
RWS-Post-True : (P : RWS-Post Wr St A) (m : RWS Ev Wr St A) (ev : Ev) (pre : St) → Set
RWS-Post-True P m ev pre =
  let (x , post , outs) = RWS-run m ev pre in
  P x post outs

-- For every RWS computation `m`, `RWS-Contract m` is the type of proofs that,
-- for all post conditions `P`, starting environments `ev` and prestates `pre`,
-- to prove that `P` holds after running `m` in `ev` and `pre`, it suffices to
-- provide a proof of the weakest precondition for `P` with respect to `m`,
-- `ev`, and `pre`.
RWS-Contract : (m : RWS Ev Wr St A) → Set₁
RWS-Contract{Ev}{Wr}{St}{A} m =
  (P : RWS-Post Wr St A)
  → (ev : Ev) (pre : St) → RWS-weakestPre m P ev pre
  → RWS-Post-True P m ev pre

-- This proves that `RWS-weakestPre` gives a *sufficient* precondition for
-- establishing a desired postcondition. Note thought that it does not prove
-- that this precondition is the weakest such one; even though this is true, it
-- is not important for our purposes.
RWS-contract : (m : RWS Ev Wr St A) → RWS-Contract m
RWS-contract (RWS-return x₁) P ev pre wp = wp
RWS-contract (RWS-bind m f) P ev pre wp
   with RWS-contract m _ ev pre wp
...| con
   with RWS-run m ev pre
...| x₁ , st₁ , outs₁ =
  RWS-contract (f x₁) _ ev st₁ (con x₁ refl)
RWS-contract (RWS-gets f) P ev pre wp = wp
RWS-contract (RWS-put x₁) P ev pre wp = wp
RWS-contract RWS-ask P ev pre wp = wp
RWS-contract (RWS-tell x₁) P ev pre wp = wp
RWS-contract{Ev}{Wr}{St}{A} (RWS-if gs) P ev pre wp = RWS-contract-if gs P ev pre wp
  where
  RWS-contract-if : (gs : Guards (RWS Ev Wr St A)) → RWS-Contract (RWS-if gs)
  RWS-contract-if (clause (b ≔ c) gs) P ev pre (wp₁ , wp₂)
    with toBool b
  ...| true = RWS-contract c _ ev pre (wp₁ refl)
  ...| false = RWS-contract-if gs _ ev pre (wp₂ refl)
  RWS-contract-if (otherwise≔ x) P ev pre wp =
    RWS-contract x P ev pre wp
RWS-contract (RWS-either f₁ f₂ (Left x)) P ev pre (wp₁ , wp₂) =
  RWS-contract (f₁ x) _ ev pre (wp₁ x refl)
RWS-contract (RWS-either f₁ f₂ (Right y)) P ev pre (wp₁ , wp₂) =
  RWS-contract (f₂ y) _ ev pre (wp₂ y refl)
RWS-contract (RWS-ebind m f) P ev pre wp
   with RWS-contract m _ ev pre wp
...| con
   with RWS-run m ev pre
... | Left x , st₁ , outs₁ = con
... | Right y , st₁ , outs₁ = RWS-contract (f y) _ ev st₁ (con y refl)
RWS-contract (RWS-maybe f₁ f₂ nothing) P ev pre (wp₁ , wp₂)
  = RWS-contract f₁ _ ev pre (wp₁ refl)
RWS-contract (RWS-maybe f₁ f₂ (just x)) P ev pre (wp₁ , wp₂) =
  RWS-contract (f₂ x) _ ev pre (wp₂ x refl)

-- This helper function is primarily used to take a proof concerning one
-- computation `m` and show that that proof implies a property concerning a
-- larger computation which contains `m`.
RWS-⇒
  : ∀ {P Q : RWS-Post Wr St A}
    → ∀ m (ev : Ev) st
    → RWS-weakestPre m P ev st
    → RWS-Post-⇒ P Q
    → RWS-weakestPre m Q ev st
RWS-⇒ (RWS-return x) ev st pre pf = pf x st [] pre
RWS-⇒ (RWS-bind m f) ev st pre pf =
  RWS-⇒
    m ev st pre
    (λ r₁ st₁ outs₁ pf₁ x x≡ →
      RWS-⇒
        (f x) ev st₁ (pf₁ x x≡)
        (λ r₂ st₂ outs₂ pf₂ → pf r₂ st₂ (outs₁ ++ outs₂) pf₂))
RWS-⇒ (RWS-gets f) ev st pre pf = pf _ _ _ pre
RWS-⇒ (RWS-put x)  ev st pre pf = pf _ _ _ pre
RWS-⇒ RWS-ask      ev st pre pf = pf _ _ _ pre
RWS-⇒ (RWS-tell x) ev st pre pf = pf _ _ _ pre
RWS-⇒ (RWS-if (otherwise≔ x)) ev st pre pf = RWS-⇒ x ev st pre pf
RWS-⇒ (RWS-if (clause (b ≔ c) cs)) ev st (pre₁ , pre₂) pf =
  (λ pf' → RWS-⇒ c ev st (pre₁ pf') pf)
  , λ pf' → RWS-⇒ (RWS-if cs) ev st (pre₂ pf') pf
proj₁ (RWS-⇒ (RWS-either f₁ f₂ (Left x)) ev st (pre₁ , pre₂) pf) x₁ x₁≡ =
  RWS-⇒ (f₁ x₁) ev st (pre₁ x₁ x₁≡) pf
proj₂ (RWS-⇒ (RWS-either f₁ f₂ (Left x) ) ev st (pre₁ , pre₂) pf) y ()
proj₁ (RWS-⇒ (RWS-either f₁ f₂ (Right y)) ev st (pre₁ , pre₂) pf) y₁ ()
proj₂ (RWS-⇒ (RWS-either f₁ f₂ (Right y)) ev st (pre₁ , pre₂) pf) y₁ y₁≡ =
  RWS-⇒ (f₂ y₁) ev st (pre₂ y₁ y₁≡) pf
RWS-⇒ (RWS-ebind m f) ev st pre pf =
  RWS-⇒ m ev st pre
        (λ { (Left x₁) st₁ outs x → pf _ _ _ x
             ; (Right y) st₁ outs x → λ c x₁ →
                 RWS-⇒ (f c) ev st₁ (x c x₁) (λ r st₂ outs₁ x₂ → pf r st₂ (outs ++ outs₁) x₂) })
proj₁ (RWS-⇒ (RWS-maybe m f x) ev st (pre₁ , pre₂) pf) ≡nothing = RWS-⇒ m ev st (pre₁ ≡nothing) pf
proj₂ (RWS-⇒ (RWS-maybe m f x) ev st (pre₁ , pre₂) pf) b b≡     = RWS-⇒ (f b) ev st (pre₂ b b≡) pf

RWS-⇒-bind
  : ∀ {P : RWS-Post Wr St A}
      {Q : RWS-Post Wr St B}
    → {f : A → RWS Ev Wr St B}
    → ∀ m ev st
    → RWS-weakestPre m P ev st
    → RWS-Post-⇒ P (RWS-weakestPre-bindPost ev f Q)
    → RWS-weakestPre (RWS-bind m f) Q ev st
RWS-⇒-bind m ev st con pf =
     RWS-⇒ m ev st con pf

RWS-⇒-ebind
  : ∀ {P : RWS-Post Wr St (Either C A)}
      {Q : RWS-Post Wr St (Either C B)}
    → {f : A → RWS Ev Wr St (Either C B)}
    → ∀ m ev st
    → RWS-weakestPre m P ev st
    → RWS-Post-⇒ P (RWS-weakestPre-ebindPost ev f Q)
    → RWS-weakestPre (RWS-ebind m f) Q ev st
RWS-⇒-ebind m ev st con pf =
  RWS-⇒ m ev st con pf


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

module lib.modalities.Modalities where

open import lib.modalities.Truncation public


{-# OPTIONS --copatterns #-}

-- 2013-05-30 Andreas, Oury's counterexample to subject reduction in Coq
-- 2014-11-04 Andreas: simplified (removed force)

module MatchingOnCoinductiveRecord where

open import Common.Equality

record U : Set where
  coinductive
  constructor inn
  field
    out : U
open U

u : U
out u = u

eq : (x : U) → x ≡ inn (out x)
eq (inn y) = refl
-- should fail, as internally this is just
-- eq x = refl
-- and we do not have η for coinductive records

equ : u ≡ inn u
equ = eq u
-- normalizes to refl, which does not have type u ≡ inn u


module Issue1760d where

-- Skipping a new-style mutual block: Anywhere before the declaration or
-- the definition of a data/record in the block (case: record).
{-# NO_POSITIVITY_CHECK #-}
record U₁ : Set
data D₁   : Set

record U₁ where
  field ap : U₁ → U₁

data D₁ where
  lam : (D₁ → D₁) → D₁

-- Skipping a new-style mutual block: Anywhere before the declaration or
-- the definition of a data/record in the block (case: data).
record U₂ : Set
data D₂   : Set

record U₂ where
  field ap : U₂ → U₂

{-# NO_POSITIVITY_CHECK #-}
data D₂ where
  lam : (D₂ → D₂) → D₂


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

module Definition.Conversion.Soundness where

open import Definition.Untyped
open import Definition.Typed
open import Definition.Typed.Properties
open import Definition.Conversion
open import Definition.Conversion.Whnf
open import Definition.Typed.Consequences.InverseUniv
open import Definition.Typed.Consequences.Syntactic
open import Definition.Typed.Consequences.NeTypeEq

open import Tools.Product
import Tools.PropositionalEquality as PE

mutual
  -- Algorithmic equality of neutrals is well-formed.
  soundness~↑ : ∀ {k l A Γ} → Γ ⊢ k ~ l ↑ A → Γ ⊢ k ≡ l ∷ A
  soundness~↑ (var-refl x x≡y) = PE.subst (λ y → _ ⊢ _ ≡ var y ∷ _) x≡y (refl x)
  soundness~↑ (app-cong k~l x₁) = app-cong (soundness~↓ k~l) (soundnessConv↑Term x₁)
  soundness~↑ (fst-cong x) =
    let p≡ = soundness~↓ x
        ⊢ΣFG = proj₁ (syntacticEqTerm p≡)
        ⊢F , ⊢G = syntacticΣ ⊢ΣFG
    in  fst-cong ⊢F ⊢G p≡
  soundness~↑ (snd-cong x) =
    let p≡ = soundness~↓ x
        ⊢ΣFG = proj₁ (syntacticEqTerm p≡)
        ⊢F , ⊢G = syntacticΣ ⊢ΣFG
    in  snd-cong ⊢F ⊢G p≡
  soundness~↑ (natrec-cong x₁ x₂ x₃ k~l) =
    natrec-cong (soundnessConv↑ x₁) (soundnessConv↑Term x₂)
                (soundnessConv↑Term x₃) (soundness~↓ k~l)
  soundness~↑ (Emptyrec-cong x₁ k~l) =
    Emptyrec-cong (soundnessConv↑ x₁) (soundness~↓ k~l)

  -- Algorithmic equality of neutrals in WHNF is well-formed.
  soundness~↓ : ∀ {k l A Γ} → Γ ⊢ k ~ l ↓ A → Γ ⊢ k ≡ l ∷ A
  soundness~↓ ([~] A₁ D whnfA k~l) = conv (soundness~↑ k~l) (subset* D)

  -- Algorithmic equality of types is well-formed.
  soundnessConv↑ : ∀ {A B Γ} → Γ ⊢ A [conv↑] B → Γ ⊢ A ≡ B
  soundnessConv↑ ([↑] A′ B′ D D′ whnfA′ whnfB′ A′<>B′) =
    trans (subset* D) (trans (soundnessConv↓ A′<>B′) (sym (subset* D′)))

  -- Algorithmic equality of types in WHNF is well-formed.
  soundnessConv↓ : ∀ {A B Γ} → Γ ⊢ A [conv↓] B → Γ ⊢ A ≡ B
  soundnessConv↓ (U-refl ⊢Γ) = refl (Uⱼ ⊢Γ)
  soundnessConv↓ (ℕ-refl ⊢Γ) = refl (ℕⱼ ⊢Γ)
  soundnessConv↓ (Empty-refl ⊢Γ) = refl (Emptyⱼ ⊢Γ)
  soundnessConv↓ (Unit-refl ⊢Γ) = refl (Unitⱼ ⊢Γ)
  soundnessConv↓ (ne x) = univ (soundness~↓ x)
  soundnessConv↓ (Π-cong F c c₁) =
    Π-cong F (soundnessConv↑ c) (soundnessConv↑ c₁)
  soundnessConv↓ (Σ-cong F c c₁) =
    Σ-cong F (soundnessConv↑ c) (soundnessConv↑ c₁)

  -- Algorithmic equality of terms is well-formed.
  soundnessConv↑Term : ∀ {a b A Γ} → Γ ⊢ a [conv↑] b ∷ A → Γ ⊢ a ≡ b ∷ A
  soundnessConv↑Term ([↑]ₜ B t′ u′ D d d′ whnfB whnft′ whnfu′ t<>u) =
    conv (trans (subset*Term d)
                (trans (soundnessConv↓Term t<>u)
                       (sym (subset*Term d′))))
         (sym (subset* D))

  -- Algorithmic equality of terms in WHNF is well-formed.
  soundnessConv↓Term : ∀ {a b A Γ} → Γ ⊢ a [conv↓] b ∷ A → Γ ⊢ a ≡ b ∷ A
  soundnessConv↓Term (ℕ-ins x) = soundness~↓ x
  soundnessConv↓Term (Empty-ins x) = soundness~↓ x
  soundnessConv↓Term (Unit-ins x) = soundness~↓ x
  soundnessConv↓Term (ne-ins t u x x₁) =
    let _ , neA , _ = ne~↓ x₁
        _ , t∷M , _ = syntacticEqTerm (soundness~↓ x₁)
        M≡A = neTypeEq neA t∷M t
    in  conv (soundness~↓ x₁) M≡A
  soundnessConv↓Term (univ x x₁ x₂) = inverseUnivEq x (soundnessConv↓ x₂)
  soundnessConv↓Term (zero-refl ⊢Γ) = refl (zeroⱼ ⊢Γ)
  soundnessConv↓Term (suc-cong c) = suc-cong (soundnessConv↑Term c)
  soundnessConv↓Term (η-eq x x₁ y y₁ c) =
    let ⊢ΠFG = syntacticTerm x
        ⊢F , _ = syntacticΠ ⊢ΠFG
    in  η-eq ⊢F x x₁ (soundnessConv↑Term c)
  soundnessConv↓Term (Σ-η ⊢p ⊢r pProd rProd fstConv sndConv) =
    let ⊢ΣFG = syntacticTerm ⊢p
        ⊢F , ⊢G = syntacticΣ ⊢ΣFG
        fst≡ = soundnessConv↑Term fstConv
        snd≡ = soundnessConv↑Term sndConv
    in  Σ-η ⊢F ⊢G ⊢p ⊢r fst≡ snd≡
  soundnessConv↓Term (η-unit [a] [b] aUnit bUnit) = η-unit [a] [b]


open import Data.List
open import Data.Product
open import Relation.Unary hiding (_∈_)
open import Relation.Ternary.Separation

module Relation.Ternary.Separation.Monad.State where

open import Level hiding (Lift)
open import Function using (_∘_; case_of_)
open import Relation.Binary.PropositionalEquality using (refl; _≡_)
import Relation.Binary.HeterogeneousEquality as HEq
open import Relation.Unary.PredicateTransformer hiding (_⊔_; [_])
open import Relation.Ternary.Separation.Construct.List
open import Relation.Ternary.Separation.Construct.Product
open import Relation.Ternary.Separation.Construct.Market
open import Relation.Ternary.Separation.Morphisms
open import Relation.Ternary.Separation.Monad

open import Data.Unit
open import Data.Product
open import Data.List.Relation.Ternary.Interleaving.Propositional as I

open Monads

module _ {ℓ} {C : Set ℓ} {{r : RawSep C}} {u} {{s : IsUnitalSep r u}} where

  open Morphism (market {A = C}) public

  STATET : (M : Pt (Market C) ℓ) → (l r : Pred (C × C) ℓ) → Pt C ℓ
  STATET M St St' P = (● St ─✴ M (J P ✴ ● St')) ∘ demand

  StateT : (M : Pt (Market C) ℓ) → Pred (C × C) ℓ → Pt C ℓ
  StateT M St = STATET M St St

  open import Relation.Ternary.Separation.Monad.Identity

  State : Pred (C × C) ℓ → Pt C ℓ
  State St = STATET Identity.Id St St

module StateTransformer {ℓ}
  {C : Set ℓ} {u}
  {{r : RawSep C}}
  {{s : IsUnitalSep r u}}
  (M : Pt (Market C) ℓ)
  {{monad : Monads.Monad ⊤ ℓ (λ _ _ → M) }}
  {St : Pred (C × C) ℓ}
  where

  instance
    state-monad : Monad ⊤ _ (λ _ _ → StateT M St)
    app (Monad.return state-monad px) st σ₂ = return (inj px ×⟨ σ₂ ⟩ st )
    app (app (Monad.bind state-monad {P = P} {Q = Q} f) m σ₁) st@(lift _ _) σ₂@(offerᵣ σ₅) with ⊎-assoc (demand σ₁) σ₂
    ... | _ , σ₃ , σ₄ = app (bind bound) (app m st σ₄) σ₃
      where
        bound : ((J P ✴ ● St) ─✴ M (J Q ✴ ● St)) (demand _)
        app bound (inj px ×⟨ offerᵣ σ₅ ⟩ st') (offerᵣ σ₆) with ⊎-unassoc σ₅ σ₆
        ... | _ , τ₁ , τ₂ = let mq = app f px (⊎-comm τ₁) in app mq st' (offerᵣ τ₂)

  {- Lift an M computation into a transformed state operation -}
  liftM : ∀ {Φ P} → M P (demand Φ) → StateT M St (P ∘ demand) Φ
  app (liftM mp) (lift μ k) σ@(offerᵣ _) =
    app (mapM′ (wand λ where px σ@(offerₗ _) → inj px ×⟨ ⊎-comm σ ⟩ (lift μ k))) mp (⊎-comm σ)

  {- Lift a state computation into a transformed state operation -}
  liftState : ∀ {P} → ∀[ State St P ⇒ StateT M St P ]
  app (liftState mp) st σ = Monad.return monad (app mp st σ)

module StateWithErr {ℓ}
  {C : Set ℓ} {u}
  {{r : RawSep C}}
  {{s : IsUnitalSep r u}}
  (Exc : Set ℓ) where

  open import Relation.Ternary.Separation.Monad.Error
  open ExceptMonad {A = Market C} Exc public
  open StateTransformer {C = C} (Except Exc) {{ monad = except-monad }} public

  open import Data.Sum

  State? : ∀ (S : Pred (C × C) ℓ) → Pt C ℓ
  State? = StateT (Except Exc)

  _orElse_ : ∀ {S P} {M : Pt (Market C) ℓ} {{monad : Monads.Monad ⊤ ℓ (λ _ _ → M) }}
                → ∀[ State? S P ⇒ (⋂[ _ ∶ Exc ] StateT M S P) ⇒ StateT M S P ]
  app (mp orElse mq) μ σ with app mp μ σ
  ... | error e = app (mq e) μ σ
  ... | ✓ px    = return px

  try : ∀ {S P} → ε[ State? S P ] → ε[ State S (Emp ∪ P) ]
  app (try mp?) st σ with app mp? st σ
  ... | error e                = inj (inj₁ empty) ×⟨ σ ⟩ st
  ... | ✓ (inj px ×⟨ σ' ⟩ st') = inj (inj₂ px) ×⟨ σ' ⟩ st'

  raise : ∀ {S P} → Exc → ∀[ State? S P ]
  app (raise {P} e) μ σ = partial (inj₁ e)


{-# NON_TERMINATING #-}

mutual

  data D : Set where
    c : T₁ → D

  T₁ : Set
  T₁ = T₂

  T₂ : Set
  T₂ = T₁ → D


-- Andreas, 2012-10-02
-- {-# OPTIONS -v tc.conv.level:100 -v tc.constr.add:40 -v tc.meta:50 -v tc.inj.use:30 -v 80 #-}
module Issue689 where

open import Common.Level

data Bad : Set₁ where
  c : Set₁ → Bad

-- this should not leave unsolvable constraints, but report an error


{-# OPTIONS --cubical --postfix-projections #-}

open import Prelude
open import Algebra
open import Container

module Control.Monad.ListT
  {ℓ}
  (𝔽 : Container ℓ ℓ)
  (is-mon : IsMonad {ℓ} ⟦ 𝔽 ⟧ )
  where

open IsMonad is-mon

postulate
  cmap-return : (f : A → B) (x : ⟦ 𝔽 ⟧ A) →
                (cmap f x ≡ (x >>= return ∘ f))

infixr 5 _∷_
mutual
  List : Type ℓ → Type _
  List A = ⟦ 𝔽 ⟧ (Cons A)

  data Cons (A : Type ℓ) : Type ℓ where
    []  : Cons A
    _∷_ : (x : A) → (xs : List A) → Cons A

data ℭ𝔬𝔫𝔰 (A : Type ℓ) (P : List A → Type ℓ) : Type ℓ where
  [] : ℭ𝔬𝔫𝔰 A P
  _∷_⟨_⟩ : (x : A) → (xs : List A) → (P⟨xs⟩ : P xs) → ℭ𝔬𝔫𝔰 A P

module _ (P : List A → Type ℓ) where
  wrapc : ℭ𝔬𝔫𝔰 A P → Cons A
  wrapc [] = []
  wrapc (x ∷ xs ⟨ P⟨xs⟩ ⟩) = x ∷ xs

  wrap : ⟦ 𝔽 ⟧ (ℭ𝔬𝔫𝔰 A P) → List A
  wrap = cmap wrapc
  {-# INLINE wrap #-}

  module _ (ψ : (x : ⟦ 𝔽 ⟧ (ℭ𝔬𝔫𝔰 A P)) → P (wrap x)) where
    elim : (x : List A) → P x
    elimc : Cons A → ℭ𝔬𝔫𝔰 A P
    wrapc-elimc : (c : Cons A) → wrapc (elimc c) ≡ c

    wrapc-elimc []       i = []
    wrapc-elimc (x ∷ xs) i = x ∷ xs

    elimc [] = []
    elimc (x ∷ xs) = x ∷ xs ⟨ elim xs ⟩

    elim xs =
      subst
        P
        (cong (xs .fst ,_) (funExt (λ x → wrapc-elimc (xs .snd x))))
        (ψ (cmap elimc xs))

module _  (ϕ : ⟦ 𝔽 ⟧ (ℭ𝔬𝔫𝔰 A (const B)) → B) where
  para : List A → B
  parac : Cons A → ℭ𝔬𝔫𝔰 A (const B)

  para xs = ϕ (cmap parac xs)

  parac [] = []
  parac (x ∷ xs) = x ∷ xs ⟨ para xs ⟩

++-ϕ : List A → ⟦ 𝔽 ⟧ (ℭ𝔬𝔫𝔰 A (const (List A))) → List A
++-ϕ ys xs = xs >>= λ { [] → ys ; (x ∷ _ ⟨ xs ⟩) → return (x ∷ xs) }

infixr 5 _++_
_++_ : List A → List A → List A
xs ++ ys = para (++-ϕ ys) xs

cmap-comp : (f : B → C) (g : A → B) (x : ⟦ 𝔽 ⟧ A) → cmap f (cmap g x) ≡ cmap (f ∘ g) x
cmap-comp f g x = refl

cmap-id : (x : ⟦ 𝔽 ⟧ A) → cmap id x ≡ x
cmap-id x = refl

open import Path.Reasoning

++-id : (xs : List A) → xs ++ return [] ≡ xs
++-id {A = A} = elim P ψ
  where
  P : List A → Type ℓ
  P xs = xs ++ return [] ≡ xs

  ϕ : ⟦ 𝔽 ⟧ (ℭ𝔬𝔫𝔰 A (const (List A))) → List A
  ϕ = ++-ϕ (return [])

  ϕ′ : ℭ𝔬𝔫𝔰 A (const (List A)) → Cons A
  ϕ′ [] = []
  ϕ′ (x ∷ xs ⟨ P⟨xs⟩ ⟩) = x ∷ P⟨xs⟩

  ϕ≡ : ∀ xs → ϕ xs ≡ (xs >>= return ∘′ ϕ′)
  ϕ≡ xs = cong (xs >>=_) (funExt (λ { [] → refl ; (x ∷ xs ⟨ P⟨xs⟩ ⟩) → refl }))

  lemma : (xs : ℭ𝔬𝔫𝔰 A P) → ϕ′ (parac ϕ (wrapc P xs)) ≡ wrapc P xs
  lemma [] = refl
  lemma (x ∷ xs ⟨ P⟨xs⟩ ⟩) = cong (x ∷_) P⟨xs⟩

  ψ : (xs : ⟦ 𝔽 ⟧ (ℭ𝔬𝔫𝔰 A P)) → P (wrap P xs)
  ψ xs =
    wrap P xs ++ return [] ≡⟨⟩
    para ϕ (wrap P xs) ≡⟨⟩
    ϕ (cmap (parac ϕ) (wrap P xs)) ≡⟨ ϕ≡ _ ⟩
    (cmap (parac ϕ) (wrap P xs) >>= return ∘′ ϕ′) ≡˘⟨ cmap-return ϕ′ _ ⟩
    cmap ϕ′ (cmap (parac ϕ) (wrap P xs)) ≡⟨⟩
    cmap (ϕ′ ∘ parac ϕ) (wrap P xs) ≡⟨⟩
    cmap (ϕ′ ∘ parac ϕ) (cmap (wrapc P) xs) ≡⟨⟩
    cmap (ϕ′ ∘ parac ϕ ∘ wrapc P) xs ≡⟨ cong (flip cmap xs) (funExt lemma) ⟩
    wrap P xs ∎

-- open import Cubical.Data.Sigma.Properties

-- ++-assoc : (xs ys zs : List A) → (xs ++ ys) ++ zs ≡ xs ++ (ys ++ zs)
-- ++-assoc {A = A} xs ys zs = elim P ψ xs
--   where
--   P : List A → Type ℓ
--   P xs′ = (xs′ ++ ys) ++ zs ≡ xs′ ++ (ys ++ zs)
--   {-# INLINE P #-}

--   ψ : (x : ⟦ 𝔽 ⟧ (ℭ𝔬𝔫𝔰 A P)) → P (wrap P x)
--   ψ xs = ΣPathTransport→PathΣ _ _ ({!refl!} , {!!})

-- _>>=′_ : List A → (A → List B) → List B
-- _>>=′_ {A = A} {B = B} xs k = para ϕ xs
--   where
--   ϕ : ⟦ 𝔽 ⟧ (ℭ𝔬𝔫𝔰 A (List B)) → List B
--   ϕ xs = xs >>= λ { [] → return [] ; (x ∷ xs) → k x ++ xs }


------------------------------------------------------------------------
-- Parser monad
------------------------------------------------------------------------

open import Relation.Binary
open import Relation.Binary.OrderMorphism
open import Relation.Binary.PropositionalEquality hiding (poset)
import Relation.Binary.Properties.StrictTotalOrder as STOProps
open import Data.Product
open import Level

module MonadPostulates where

postulate
  -- Input string positions.

  Position : Set
  _<P_ : Rel Position zero
  posOrdered : IsStrictTotalOrder _≡_ _<P_

  -- Input strings.

  Input : Position -> Set

  -- In order to be able to store results in a memo table (and avoid
  -- having to lift the table code to Set1) the result types have to
  -- come from the following universe:

  Result : Set
  ⟦_⟧ : Result -> Set

  -- Memoisation keys. These keys must uniquely identify the
  -- computation that they are associated with, when paired up with
  -- the current input string position.

  Key : let PosPoset = STOProps.poset
                          (record { Carrier = _ ; _≈_ = _; _<_ = _
                                  ; isStrictTotalOrder = posOrdered })
            MonoFun = PosPoset ⇒-Poset PosPoset in
         MonoFun -> Result -> Set
  _≈'_ _<_ : Rel (∃₂ Key) zero
  keyOrdered : IsStrictTotalOrder _≈'_ _<_

  -- Furthermore the underlying equality needs to be strong enough.

  funsEqual    : _≈'_ =[ proj₁ ]⇒ _≡_
  resultsEqual : _≈'_ =[ (\rfk -> proj₁ (proj₂ rfk)) ]⇒ _≡_

--  where

open _⇒-Poset_
open STOProps (record { Carrier = _ ; _≈_ = _; _<_ = _
                      ; isStrictTotalOrder = posOrdered })

import IndexedMap as Map -- renaming (Map to MemoTable)
open import Effect.Monad
open import Effect.Monad.State
import Data.List as List; open List using (List)
open import Data.Unit
open import Function
open import Data.Maybe
open import Data.Product.Relation.Binary.Lex.Strict
open import Data.Product.Relation.Binary.Pointwise.NonDependent
import Relation.Binary.Construct.On as On

------------------------------------------------------------------------
-- Monotone functions

MonoFun : Set
MonoFun = poset ⇒-Poset poset

------------------------------------------------------------------------
-- Memo tables

-- Indices and keys used by the memo table.

Index : Set
Index = Position × MonoFun × Result

data MemoTableKey : Index -> Set where
  key : forall {f r} (key : Key f r) pos -> MemoTableKey (pos , f , r)

-- Input strings of a certain maximum length.

Input≤ : Position -> Set
Input≤ pos = ∃ \pos′ -> pos′ ≤ pos × Input pos′

-- Memo table values.

Value : Index -> Set
Value (pos , f , r) = List (⟦ r ⟧ × Input≤ (fun f pos))

-- Shuffles the elements to simplify defining equality and order
-- relations for the keys.

shuffle : ∃ MemoTableKey -> Position × ∃₂ Key
shuffle ((pos , f , r) , key k .pos) = (pos , f , r , k)

-- Equality and order.

Eq : Rel (∃ MemoTableKey) _
Eq = Pointwise _≡_ _≈'_  on  shuffle

Lt : Rel (∃ MemoTableKey) _
Lt = ×-Lex _≡_ _<P_ _<_  on  shuffle

isOrdered : IsStrictTotalOrder Eq Lt
isOrdered = On.isStrictTotalOrder shuffle
              (×-isStrictTotalOrder posOrdered keyOrdered)

indicesEqual′ : Eq =[ proj₁ ]⇒ _≡_
indicesEqual′ {((_ , _ , _) , key _ ._)}
              {((_ , _ , _) , key _ ._)} (eq₁ , eq₂) =
  cong₂ _,_ eq₁ (cong₂ _,_ (funsEqual eq₂) (resultsEqual eq₂))

open Map isOrdered (\{k₁} {k₂} -> indicesEqual′ {k₁} {k₂}) Value

{-
------------------------------------------------------------------------
-- Parser monad

-- The parser monad is built upon a list monad, for backtracking, and
-- two state monads. One of the state monads stores a memo table, and
-- is unaffected by backtracking. The other state monad, which /is/
-- affected by backtracking, stores the remaining input string.

-- The memo table state monad.

module MemoState = RawMonadState (StateMonadState MemoTable)

-- The list monad.

module List = RawMonadPlus List.ListMonadPlus

-- The inner monad (memo table plus list).

module IM where

  Inner : Set -> Set
  Inner R = State MemoTable (List R)

  InnerMonadPlus : RawMonadPlus Inner
  InnerMonadPlus = record
    { monadZero = record
      { monad = record
        { return = \x -> return (List.return x)
        ; _>>=_  = \m f -> List.concat <$> (List.mapM monad f =<< m)
        }
      ; ∅ = return List.∅
      }
    ; _∣_ = \m₁ m₂ -> List._∣_ <$> m₁ ⊛ m₂
    }
    where
    open MemoState

  InnerMonadState : RawMonadState MemoTable Inner
  InnerMonadState = record
    { monad = RawMonadPlus.monad InnerMonadPlus
    ; get   = List.return <$> get
    ; put   = \s -> List.return <$> put s
    }
    where open MemoState

  open RawMonadPlus  InnerMonadPlus  public
  open RawMonadState InnerMonadState public
    using (get; put; modify)

-- The complete parser monad.

module PM where

  P : MonoFun -> Set -> Set
  P f A = forall {n} -> Input n -> IM.Inner (A × Input≤ (fun f n))

  -- Memoises the computation, assuming that the key is sufficiently
  -- unique.

  memoise : forall {f r} -> Key f r -> P f ⟦ r ⟧ -> P f ⟦ r ⟧
  memoise k p {pos} xs =
    let open IM in helper =<< lookup k′ <$> get
    where
    i = (pos , _)

    k′ : MemoTableKey i
    k′ = key k pos

    helper : Maybe (Value i) -> State MemoTable (Value i)
    helper (just ris) = return ris  where open MemoState
    helper nothing    = p xs                   >>= \ris ->
                        modify (insert k′ ris) >>
                        return ris
      where open MemoState

  -- Other monadic operations.

  return : forall {A} -> A -> P idM A
  return a = \xs -> IM.return (a , _ , refl , xs)

  _>>=_ : forall {A B f g} -> P f A -> (A -> P g B) -> P (g ∘M f) B
  _>>=_ {g = g} m₁ m₂ xs =
    m₁ xs ⟨ IM._>>=_ ⟩ \ays ->
    let a  = proj₁ ays
        le = proj₁ $ proj₂ $ proj₂ ays
        ys = proj₂ $ proj₂ $ proj₂ ays in
    fix le ⟨ IM._<$>_ ⟩ m₂ a ys
    where
    lemma : forall {i j k} -> j ≤ k -> i ≤ fun g j -> i ≤ fun g k
    lemma j≤k i≤gj = trans i≤gj (monotone g j≤k)

    fix : forall {A i j} -> i ≤ j ->
          A × Input≤ (fun g i) ->
          A × Input≤ (fun g j)
    fix le = map-× id (map-Σ id (map-× (lemma le) id))

  ∅ : forall {A} -> P idM A
  ∅ = const IM.∅

  _∣_ : forall {A f} -> P f A -> P f A -> P f A
  m₁ ∣ m₂ = \xs -> IM._∣_ (m₁ xs) (m₂ xs)

  put : forall {n} -> Input n -> P (constM n) ⊤
  put xs = \_ -> IM.return (_ , _ , refl , xs)

  modify : forall {A f} ->
           (forall {n} -> Input n -> A × Input (fun f n)) ->
           P f A
  modify g xs = IM.return (proj₁ gxs , _ , refl , proj₂ gxs)
    where gxs = g xs
-}


-- {-# OPTIONS -v tc.constr.findInScope:15 -v tc.meta.new:50 #-}
-- Andreas, 2012-10-20 issue raised by d.starosud
-- solved by dropping UnBlock constraints during trial candidate assignment
module Fail.Issue723 where

import Common.Level
open import Common.Prelude using (Bool; false; zero) renaming (Nat to ℕ)

record Default {ℓ} (A : Set ℓ) : Set ℓ where
  constructor create
  field default : A

open Default {{...}} using (default)

instance
  defBool : Default Bool
  defBool = create false

  defSet  : Default Set
  defSet  = create Bool

  defNat : Default ℕ
  defNat = create zero

  defDef : Default (Default ℕ)
  defDef = create defNat

  defFunc : ∀ {ℓ} {A : Set ℓ} → Default (A → A)
  defFunc = create (λ x → x)

-- these lines are compiled successfully

id : ∀ {a} (A : Set a) → A → A
id A x = x

syntax id A x = x ∶ A

n₁ = default ∶ ℕ
f₁ = default ∶ (ℕ → ℕ)

-- WAS: but this one hangs on "Checking"
n₂ = default (5 ∶ ℕ) ∶ ℕ
-- n₂ = id ℕ (default (id ℕ 5))

n : ℕ
n = default 5
-- now we get unsolved metas
-- that's kind of ok

n₃ = (default ∶ (_ → _)) 5
-- this one works again (before: also unsolved metas (worked before switching of the occurs-error (Issue 795)))


{-  -}
-- starting from builtins
-- forgot what the point of this was...
module Oscar.Data6 where

open import Oscar.Category.Semigroupoid
open import Oscar.Category.Category
open import Oscar.Category.Morphism
open import Oscar.Category.Setoid
open import Oscar.Function

open import Agda.Builtin.Unit using () renaming (⊤ to 𝟙; tt to ∅)
open import Agda.Builtin.Nat using () renaming (Nat to ℕ; zero to ∅; suc to ↑_)
open import Agda.Builtin.List using () renaming (List to [_]ℕ; [] to ∅; _∷_ to _+_)

open import Oscar.Level

⟦_⟧ℕ[<_↓]
⟦_⟧ℕ[_≤_↓]
⟦_⟧ℕ[↥_≤_]
⟦_⟧ℕ[↓_≤_↓]

-- Fin (with a payload)
data ⟦_⟧ℕ[0…_-1] {a} (A : ℕ → Set a) : ℕ → Set a where
  ∅ : ∀ {n} → ⟦ A ⟧ℕ[<↑ ↑ n ]
  _∷_ : ∀ {n} → A n → ⟦ A ⟧ℕ[ n ] → ⟦ A ⟧ℕ[<↑ ↑ n ]

-- Vec (with an (optional) index)
data ⟦_⟧ℕ[≤_] {a} (A : ℕ → Set a) : ℕ → Set a where
  ∅ : ⟦ A ⟧ℕ[ ∅ ₀]
  _∷_ : ∀ {n} → A n → ⟦ A ⟧ℕ[ n ₀] → ⟦ A ⟧ℕ[ ¡ n ₀]

-- m ≤ n, counting down from n-1 to m
data ⟦_⟧ℕ[_≤_↓] {a} (A : ℕ → Set a) (m : ℕ) : ℕ → Set a where
  ∅ : ⟦ A ⟧ℕ[ m ≤ m ↓]
  _∷_ : ∀ {n} → A n → ⟦ A ⟧ℕ[ m ≤ n ↓] → ⟦ A ⟧ℕ[ m ≤ ¡ n ↓]

-- m ≤ n, counting up from m to n-1
data ⟦_⟧ℕ[↑_≤_] {a} (A : ℕ → Set a) (m : ℕ) : ℕ → Set a where
  ∅ : ⟦ A ⟧ℕ[↑ m ≤ m ]
  _∷_ : ∀ {n} → A m → ⟦ A ⟧ℕ[↑ ¡ m ≤ n ] → ⟦ A ⟧ℕ[↑ m ≤ n ]

-- Inj (almost)
data ⟦_⟧ℕ[↓_≤_↓] {a} (A : ℕ → ℕ → Set a) : ℕ → ℕ → Set a where
  ∅ : ∀ {n} → ⟦ A ⟧ℕ[↓ ∅ ≤ n ↓]
  _∷_ : ∀ {m n} → A m n → ⟦ A ⟧ℕ[↓ m ≤ n ↓] → ⟦ A ⟧ℕ[↓ ¡ m ≤ ¡ n ↓]

⟦_⟧ℕ[_⇒_]∞ : ∀ {a} (A : ℕ → Set a) → ℕ → ℕ → Set a
⟦ A ⟧ℕ[ m ⇒ n ]∞ = A m → A n

-- Fin (with a payload)
data ⟦_⟧ℕ[<_↓] {a} (A : ℕ → Set a) : ℕ → Set a where
  ∅ : ∀ {n} → ⟦ A ⟧[< ↑ n ↓]
  _∷_ : ∀ {n} → A n → ⟦ A ⟧ℕ[< n ] → ⟦ A ⟧[< ↑ n ↓]

-- -- Vec (with an (optional) index)
data ℕ[_]=_ {a} (A : ℕ → Set a) : ℕ → Set a where
  ∅ : ℕ[ A ]= ∅
  _∷_ : ∀ {n} → A n → ℕ[ A ]= ↑ n → ℕ[ A ]= ↑ n

ℕ=_ = ℕ[ const 𝟙 ]=_

-- m ≤ n, counting down from n-1 to m

data ℕ[_]≥_<↓_ {a} (A : ℕ → Set a) (m : ℕ) : ℕ → Set a where
  ∅ : ℕ[ A ]≥ m <↓ m
  _∷_ : ∀ {n} → A n → ℕ[ A ]≥ m <↓ n → ℕ[ A ]≥ m <↓ ↑ n

ℕ≥_<↓_ = ℕ[ const 𝟙 ]≥_<↓_

-- m ≤ n, counting up from m to n-1
data ℕ[_]≥↑_<_ {a} (A : ℕ → Set a) (m : ℕ) : ℕ → Set a where
  ∅ : ℕ[ A ]≥↑ m < m
  _∷_ : ∀ {n} → A m → ℕ[ A ]≥↑ ↑ m < n → ℕ[ A ]≥↑ m < n

ℕ≥↑_<_ = ℕ[ const 𝟙 ]≥↑_<_

-- -- Inj (almost)
-- data ⟦_⟧[↓_≤_↓] {a} (A : ⟦⟧ → ⟦⟧ → Set a) : ⟦⟧ → ⟦⟧ → Set a where
--   ∅ : ∀ {n} → ⟦ A ⟧[↓ ∅ ≤ n ↓]
--   _∷_ : ∀ {m n} → A m n → ⟦ A ⟧[↓ m ≤ n ↓] → ⟦ A ⟧[↓ ¡ m ≤ ¡ n ↓]

-- ⟦⟧[↓_≤_↓] = ⟦ Const Const ⊤ ⟧[↓_≤_↓]

-- ⟦_⟧[_⇒_]∞ : ∀ {a} (A : ⟦⟧ → Set a) → ⟦⟧ → ⟦⟧ → Set a
-- ⟦ A ⟧[ m ⇒ n ]∞ = A m → A n

-- --open import Oscar.Data.Equality
-- --open import Oscar.Data.Equality.properties

-- module _ {𝔬 𝔪 𝔮} (G : Semigroupoid 𝔬 𝔪 𝔮) where
--   open Semigroupoid G

-- {-
--   _≋̇_ : ∀ {a} {A : ⋆ → Set a} {m n : ⋆} → (A m → A n) → (A m → A n) → Set 𝔮
--   _≋̇_ {A = A} {m = m} m→n₁ m→n₂ = {!∀ (am : A m) → m→n₁ am ≋ m→n₂ am!}

--   cat2 : ∀ {a} (A : ⋆ → Set a) → Category {!!} {!!} {!!}
--   Semigroupoid.⋆ (Category.semigroupoid (cat2 A)) = ⋆
--   Setoid.⋆ ((Semigroupoid.𝔐 (Category.semigroupoid (cat2 A)) Morphism.⇒ m) n) = A m → A n
--   IsSetoid._≋_ (Setoid.isSetoid ((Semigroupoid.𝔐 (Category.semigroupoid (cat2 A)) Morphism.⇒ m) n)) = _≡̇_
--   IsSetoid.isEquivalence (Setoid.isSetoid ((Semigroupoid.𝔐 (Category.semigroupoid (cat2 A)) Morphism.⇒ m) n)) = it
--   Semigroupoid._∙_ (Category.semigroupoid (cat2 A)) g f = g ∘ f
--   Semigroupoid.isSemigroupoid (Category.semigroupoid (cat2 A)) = it
--   Category.ε (cat2 A) = id
--   Category.isCategory (cat2 A) = it

--   cat2G : ∀ {a} (A : ⋆ → Set a) → ∀ ℓ ⦃ _ : ∀ {n : ⋆} → IsSetoid (A n) ℓ ⦄ → Category {!!} {!!} {!!}
--   Semigroupoid.⋆ (Category.semigroupoid (cat2G A ℓ)) = ⋆
--   Setoid.⋆ ((Semigroupoid.𝔐 (Category.semigroupoid (cat2G A ℓ)) Morphism.⇒ m) n) = A m → A n
--   IsSetoid._≋_ (Setoid.isSetoid ((Semigroupoid.𝔐 (Category.semigroupoid (cat2G A ℓ)) Morphism.⇒ m) n)) m↦n₁ m↦n₂ = ∀ (am : A m) → m↦n₁ am ≋ m↦n₂ am
--   -- ∀ (am : A m) → m↦n₁ am ≋ m↦n₂ am
--   {-
--   _≋̇_ : ∀ {a} {A : ⋆ → Set a} {m n : ⋆} → (A m → A n) → (A m → A n) → Set 𝔮
--   _≋̇_ {A = A} {m = m} m→n₁ m→n₂ = {!∀ (am : A m) → m→n₁ am ≋ m→n₂ am!}
--   -}
--   IsSetoid.isEquivalence (Setoid.isSetoid ((Semigroupoid.𝔐 (Category.semigroupoid (cat2G A ℓ)) Morphism.⇒ m) n)) = {!it!}
--   Semigroupoid._∙_ (Category.semigroupoid (cat2G A ℓ)) g f = g ∘ f
--   Semigroupoid.isSemigroupoid (Category.semigroupoid (cat2G A ℓ)) = {!it!}
--   Category.ε (cat2G A ℓ) = id
--   Category.isCategory (cat2G A ℓ) = {!it!}
-- -}

-- infix 21 ‼_
-- pattern ‼_ ⟦A⟧ = tt ∷ ⟦A⟧ -- tricky, works for all above _∷_ constructors only because it is defined afterwards, won't work for any later-defined constructors

-- open import Agda.Primitive
-- open import Oscar.Data.Product
-- open import Oscar.Function

-- postulate
--   ℓ : Level
--   Term : ⟦⟧ → Set ℓ
--   Step : ⟦⟧ → Set ℓ

-- Fin = ⟦⟧[_]

-- Inj = ⟦ Const Fin ⟧[↓_≤_↓]

-- Terms = λ N n → ⟦ Const (Term n) ⟧[ N ₀]

-- AList = ⟦ (λ n → Term n × Fin (¡ n)) ⟧[_≤_↓]

-- Fx : ∀ {a} {A : Set a} → A → A → ∀ {b₁} (B₁ : A → Set b₁) → ∀ {b₂} (B₂ : A → Set b₂) → Set (b₁ ⊔ b₂)
-- Fx m n B₁ B₂ = B₁ m → B₂ n

-- Fx₁ : ∀ {a} {A : Set a} → A → ∀ {b₁} (B₁ : A → Set b₁) → ∀ {b₂} (B₂ : A → Set b₂) → Set (b₁ ⊔ b₂)
-- Fx₁ n B₁ B₂ = Fx n n B₁ B₂

-- ListStep = λ n → ⟦ Step n ⟧

-- Rel : ∀ {a} {A : Set a} {b₁} (B₁ : A → Set b₁) {b₂} (B₂ : A → Set b₂) {c₁} (C₁ : A → Set c₁) {c₂} (C₂ : A → Set c₂) → Set (a ⊔ b₁ ⊔ b₂ ⊔ c₁ ⊔ c₂)
-- Rel B₁ B₂ C₁ C₂ = ∀ {m n} → Fx m n B₁ B₂ → Fx m n C₁ C₂

-- Morph : ∀ {a} {A : Set a} {b₁} {b₂} (B : (A → Set b₁) × (A → Set b₂)) {c₁} {c₂} (C₂ : (A → Set c₁) × (A → Set c₂)) → Set (a ⊔ b₁ ⊔ b₂ ⊔ c₁ ⊔ c₂)
-- Morph (B₁ , B₂) (C₁ , C₂) = ∀ {m n} → Fx m n B₁ B₂ → Fx m n C₁ C₂

-- -- functor mappings
-- postulate
--   _◃_ : Morph (Fin , Term) (Term , Term)
--   _◃s_ : ∀ N → Morph (Fin , Term) (Terms N , Terms N)
--   sub : ∀ {m n} → AList m n → Fx m n Fin Term
--   fmapS : Morph (Term , Term) (Step , Step)
--   _◃S_ : Morph (Fin , Term) (ListStep , ListStep)

-- -- ?
-- postulate
--   _⊹_ : ∀ {n} → ⟦ Step n ⟧ → Fx₁ n Term Term

-- testNat : ⟦⟧
-- testNat = ¡ ∅

-- testListNat : ⟦ ⟦⟧ ⟧
-- testListNat = ¡ ∅ ∷ ‼ ∅ ∷ ‼ ‼ ∅ ∷ ∅ ∷ ¡ ¡ ¡ ∅ ∷ ∅

-- testFin : ⟦⟧[ ¡ ¡ ∅ ]
-- testFin = ‼ ∅

-- test≤↓ : ⟦⟧[ ‼ ‼ ‼ ∅ ≤ ‼ ‼ ‼ ‼ ‼ ∅ ↓]
-- test≤↓ = ‼ ‼ ∅

-- ⓪ ⑴ ⑵ ⑶ : ⟦⟧
-- ⓪ = ∅
-- ⑴ = ‼ ∅
-- ⑵ = ‼ ⑴
-- ⑶ = ‼ ⑵

-- testInj : Inj ⑵ ⑶
-- testInj = ‼ ∅ ∷ ∅ ∷ ∅


module SubstantiveDischargeIsReflexive where

open import HasSubstantiveDischarge

record SubstantiveDischargeIsReflexive (A : Set) ⦃ _ : HasSubstantiveDischarge A A ⦄ : Set₁
 where
  field
    ≽-reflexive : (x : A) → x ≽ x

{-
record SubstantiveDischargeIsReflexive (A : Set) : Set₁
 where
  field
    overlap ⦃ hasSubstantiveDischarge ⦄ : HasSubstantiveDischarge A A
    ≽-reflexive : (x : A) → x ≽ x
-}
open SubstantiveDischargeIsReflexive ⦃ … ⦄ public
{-
record SubstantiveDischargeIsReflexive (A : Set) ⦃ _ : HasSubstantiveDischarge A A ⦄ : Set₁
 where
  field
    ≽-reflexive : {x : A} → x ≽ x

open SubstantiveDischargeIsReflexive ⦃ … ⦄
-}
{-# DISPLAY SubstantiveDischargeIsReflexive.≽-reflexive _ = ≽-reflexive #-}


-- Andreas, 2016-01-19, issue raised by Twey
-- {-# OPTIONS -v 10 #-}

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

Rel : Set → Set₁
Rel A = A → A → Set

record Category : Set₁ where
  field
    Obj : Set
    _⇒_ : Rel Obj -- unfolding the definition of Rel removes the error

record Product (C : Category) (A B : Category.Obj C) : Set where
  field
    A×B : Category.Obj C

postulate
  anything : ∀{a}{A : Set a} → A

trivial : ∀ {C} → Category.Obj C → Set
trivial _ = anything

map-obj : ∀ {P : _} → trivial (Product.A×B P) -- Note: hole _ cannot be filled
map-obj = anything

{- Error thrown during printing open metas:
piApply
  t    = Rel _24   Def Issue1783.Rel [Apply []r(MetaV (MetaId 24) [])]}
  args = @0        [[]r{Var 0 []}]
An internal error has occurred. Please report this as a bug.
Location of the error: src/full/Agda/TypeChecking/Substitute.hs:382
-}


open import Common.Prelude

postulate
  foo_bar_ : (b : Bool) → if b then Nat else Bool → Set

Test : Set
Test = foo_bar 5


{-# OPTIONS --without-K #-}
module lob where
open import common
open import well-typed-syntax
open import well-typed-quoted-syntax
open import well-typed-syntax-interpreter-full

module inner (‘X’ : Typ ε) (‘f’ : Term {Γ = ε ▻ (‘□’ ‘’ ⌜ ‘X’ ⌝T)} (W ‘X’)) where
  X : Set _
  X = Typε⇓ ‘X’

  f'' : (x : Typε⇓ (‘□’ ‘’ ⌜ ‘X’ ⌝T)) → Typε▻⇓ {‘□’ ‘’ ⌜ ‘X’ ⌝T} (W ‘X’) x
  f'' = Termε▻⇓ ‘f’

  {-f : □ ‘X’ → X
  f □‘X’ = un▻-Typε▻⇓ (Termε▻⇓ ‘f’ helper)
    where helper : {!.well-typed-syntax-interpreter.Typ⇓
                     (transfer-Typ (‘□’ ‘’ ⌜ ‘X’ ⌝T))
                     .well-typed-syntax-interpreter-full.Contextε⇓!}
          helper = {!!}-}

  dummy : Typ ε
  dummy = ‘Context’

  cast : (Γv : Σ Context Typ) → Typ (ε ▻ ‘Σ’ ‘Context’ ‘Typ’)
  cast (Γ , v) = context-pick-if {P = Typ} {Γ} (W dummy) v

  Hf : (h : Σ Context Typ) → Typ ε
  Hf h = (cast h ‘’ quote-sigma h ‘→'’ ‘X’)

  qh : Term {Γ = (ε ▻ ‘Σ’ ‘Context’ ‘Typ’)} (W (‘Typ’ ‘’ ‘ε’))
  qh = f' w‘‘’’ x
    where
      f' : Term (W (‘Typ’ ‘’ ⌜ ε ▻ ‘Σ’ ‘Context’ ‘Typ’ ⌝c))
      f' = w→ ‘cast’ ‘'’ₐ ‘VAR₀’

      x : Term (W (‘Term’ ‘’₁ ⌜ ε ⌝c ‘’ ⌜ ‘Σ’ ‘Context’ ‘Typ’ ⌝T))
      x = (w→ ‘quote-sigma’ ‘'’ₐ ‘VAR₀’)

  h2 : Typ (ε ▻ ‘Σ’ ‘Context’ ‘Typ’)
  h2 = (W1 ‘□’ ‘’ (qh w‘‘→'’’ w ⌜ ‘X’ ⌝T))

  h : Σ Context Typ
  h = ((ε ▻ ‘Σ’ ‘Context’ ‘Typ’) , h2)

  H0 : Typ ε
  H0 = Hf h

  H : Set
  H = Term {Γ = ε} H0

  ‘H0’ : □ (‘Typ’ ‘’ ⌜ ε ⌝c)
  ‘H0’ = ⌜ H0 ⌝T

  ‘H’ : Typ ε
  ‘H’ = ‘□’ ‘’ ‘H0’

  H0' : Typ ε
  H0' = ‘H’ ‘→'’ ‘X’

  H' : Set
  H' = Term {Γ = ε} H0'

  ‘H0'’ : □ (‘Typ’ ‘’ ⌜ ε ⌝c)
  ‘H0'’ = ⌜ H0' ⌝T

  ‘H'’ : Typ ε
  ‘H'’ = ‘□’ ‘’ ‘H0'’

  toH-helper-helper : ∀ {k} → h2 ≡ k
    → □ (h2 ‘’ quote-sigma h ‘→'’ ‘□’ ‘’ ⌜ h2 ‘’ quote-sigma h ‘→'’ ‘X’ ⌝T)
    → □ (k ‘’ quote-sigma h ‘→'’ ‘□’ ‘’ ⌜ k ‘’ quote-sigma h ‘→'’ ‘X’ ⌝T)
  toH-helper-helper p x = transport (λ k → □ (k ‘’ quote-sigma h ‘→'’ ‘□’ ‘’ ⌜ k ‘’ quote-sigma h ‘→'’ ‘X’ ⌝T)) p x

  toH-helper : □ (cast h ‘’ quote-sigma h ‘→'’ ‘H’)
  toH-helper = toH-helper-helper
    {k = context-pick-if {P = Typ} {ε ▻ ‘Σ’ ‘Context’ ‘Typ’} (W dummy) h2}
    (sym (context-pick-if-refl {P = Typ} {W dummy} {h2}))
    (S₀₀W1'→ ((‘‘→'’’→w‘‘→'’’ ‘∘’ ‘‘fcomp-nd’’ ‘'’ₐ (‘s←←’ ‘‘∘’’ ‘cast-refl’ ‘‘∘’’ ⌜→'⌝ ‘'’ₐ ⌜ ‘λ∙’ ‘VAR₀’ ⌝t)) ‘∘’ ⌜←'⌝))

  ‘toH’ : □ (‘H'’ ‘→'’ ‘H’)
  ‘toH’ = ⌜→'⌝ ‘∘’ ‘‘fcomp-nd’’ ‘'’ₐ (⌜→'⌝ ‘'’ₐ ⌜ toH-helper ⌝t) ‘∘’ ⌜←'⌝

  toH : H' → H
  toH h' = toH-helper ‘∘’ h'

  fromH-helper-helper : ∀ {k} → h2 ≡ k
    → □ (‘□’ ‘’ ⌜ h2 ‘’ quote-sigma h ‘→'’ ‘X’ ⌝T ‘→'’ h2 ‘’ quote-sigma h)
    → □ (‘□’ ‘’ ⌜ k ‘’ quote-sigma h ‘→'’ ‘X’ ⌝T ‘→'’ k ‘’ quote-sigma h)
  fromH-helper-helper p x = transport (λ k → □ (‘□’ ‘’ ⌜ k ‘’ quote-sigma h ‘→'’ ‘X’ ⌝T ‘→'’ k ‘’ quote-sigma h)) p x

  fromH-helper : □ (‘H’ ‘→'’ cast h ‘’ quote-sigma h)
  fromH-helper = fromH-helper-helper
    {k = context-pick-if {P = Typ} {ε ▻ ‘Σ’ ‘Context’ ‘Typ’} (W dummy) h2}
    (sym (context-pick-if-refl {P = Typ} {W dummy} {h2}))
    (S₀₀W1'← (⌜→'⌝ ‘∘’ ‘‘fcomp-nd’’ ‘'’ₐ (⌜→'⌝ ‘'’ₐ ⌜ ‘λ∙’ ‘VAR₀’ ⌝t ‘‘∘’’ ‘cast-refl'’ ‘‘∘’’ ‘s→→’) ‘∘’ w‘‘→'’’→‘‘→'’’))
  {--}
  ‘fromH’ : □ (‘H’ ‘→'’ ‘H'’)
  ‘fromH’ = ⌜→'⌝ ‘∘’ ‘‘fcomp-nd’’ ‘'’ₐ (⌜→'⌝ ‘'’ₐ ⌜ fromH-helper ⌝t) ‘∘’ ⌜←'⌝

  fromH : H → H'
  fromH h' = fromH-helper ‘∘’ h'

  lob : □ ‘X’
  lob = fromH h' ‘'’ₐ ⌜ h' ⌝t
    where
      f' : Term {ε ▻ ‘□’ ‘’ ‘H0’} (W (‘□’ ‘’ (⌜ ‘□’ ‘’ ‘H0’ ⌝T ‘‘→'’’ ⌜ ‘X’ ⌝T)))
      f' = Conv0 {‘H0’} {‘X’} (SW1W (w∀ ‘fromH’ ‘’ₐ ‘VAR₀’))

      x : Term {ε ▻ ‘□’ ‘’ ‘H0’} (W (‘□’ ‘’ ⌜ ‘H’ ⌝T))
      x = w→ ‘quote-term’ ‘'’ₐ ‘VAR₀’

      h' : H
      h' = toH (‘λ∙’ (w→ (‘λ∙’ ‘f’) ‘'’ₐ (w→→ ‘tApp-nd’ ‘'’ₐ f' ‘'’ₐ x)))

lob : {‘X’ : Typ ε} → □ ((‘□’ ‘’ ⌜ ‘X’ ⌝T) ‘→'’ ‘X’) → □ ‘X’
lob {‘X’} ‘f’ = inner.lob ‘X’ (un‘λ∙’ ‘f’)


{-# OPTIONS --warning=error #-}

module UselessAbstractPrimitive where

postulate Int : Set

{-# BUILTIN INTEGER Int #-}

abstract
  primitive
    primIntegerPlus : Int -> Int -> Int


module Base.Partial where

open import Data.String using (String)

open import Base.Free   using (Free)

record Partial (S : Set) (P : S → Set) : Set₁ where
  field
    undefined : {A : Set} → Free S P A
    error     : {A : Set} → String → Free S P A
open Partial ⦃ ... ⦄ public


{-# OPTIONS --rewriting #-}
module CF.Transform.Compile.ToJVM.Rewriting where

open import Data.List.Properties
open import Data.List.Relation.Binary.Permutation.Propositional

open import Agda.Builtin.Equality.Rewrite

{-# REWRITE map-++-commute #-}


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

open import Definition.Typed.EqualityRelation

module Definition.LogicalRelation.Substitution.Introductions.ProdBetaEta {{eqrel : EqRelSet}} where
open EqRelSet {{...}}

open import Definition.Untyped as U hiding (wk)
open import Definition.Untyped.Properties
open import Definition.Typed
open import Definition.Typed.Properties
open import Definition.Typed.Weakening as T hiding (wk; wkTerm; wkEqTerm)
open import Definition.Typed.RedSteps
open import Definition.LogicalRelation
open import Definition.LogicalRelation.ShapeView
open import Definition.LogicalRelation.Irrelevance
open import Definition.LogicalRelation.Weakening
open import Definition.LogicalRelation.Properties
open import Definition.LogicalRelation.Application
open import Definition.LogicalRelation.Substitution
open import Definition.LogicalRelation.Substitution.Properties
open import Definition.LogicalRelation.Substitution.Reduction
open import Definition.LogicalRelation.Substitution.Conversion
open import Definition.LogicalRelation.Substitution.Reflexivity
open import Definition.LogicalRelation.Substitution.Introductions.Pi
open import Definition.LogicalRelation.Substitution.Introductions.SingleSubst
open import Definition.LogicalRelation.Substitution.Introductions.Prod
open import Definition.LogicalRelation.Substitution.Introductions.Fst
open import Definition.LogicalRelation.Substitution.Introductions.Snd

open import Tools.Product
import Tools.PropositionalEquality as PE

Σ-β₁ᵛ : ∀ {F G t u Γ l}
        ([Γ] : ⊩ᵛ Γ)
        ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ])
        ([G] : Γ ∙ F ⊩ᵛ⟨ l ⟩ G / [Γ] ∙ [F])
        ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ F / [Γ] / [F])
        ([u] : Γ ⊩ᵛ⟨ l ⟩ u ∷ G [ t ] / [Γ] / substS {F} {G} [Γ] [F] [G] [t])
      → Γ ⊩ᵛ⟨ l ⟩ fst (prod t u) ≡ t ∷ F / [Γ] / [F]
Σ-β₁ᵛ {F} {G} {t} {u} {Γ} {l} [Γ] [F] [G] [t] [u] =
  let [Gt] = substS {F} {G} {t} [Γ] [F] [G] [t]
      fst⇒t : Γ ⊩ᵛ fst (prod t u) ⇒ t ∷ F / [Γ]
      fst⇒t = (λ {Δ} {σ} ⊢Δ [σ] →
                let ⊩σF = proj₁ ([F] ⊢Δ [σ])
                    ⊢σF = escape ⊩σF

                    [Fσ] = liftSubstS {F = F} {σ = σ} [Γ] ⊢Δ [F] [σ]
                    ⊩σG : Δ ∙ subst σ F ⊩⟨ l ⟩ subst (liftSubst σ) G
                    ⊩σG = proj₁ ([G] (⊢Δ ∙ ⊢σF) [Fσ])
                    ⊢σG = escape ⊩σG

                    ⊩σt = proj₁ ([t] ⊢Δ [σ])
                    ⊢σt = escapeTerm ⊩σF ⊩σt

                    ⊩σGt₁ = proj₁ ([Gt] ⊢Δ [σ])
                    ⊩σGt = irrelevance′ (singleSubstLift G t) ⊩σGt₁

                    ⊩σu₁ = proj₁ ([u] ⊢Δ [σ])
                    ⊩σu = irrelevanceTerm′ (singleSubstLift G t) ⊩σGt₁ ⊩σGt ⊩σu₁
                    ⊢σu = escapeTerm ⊩σGt ⊩σu
                in  Σ-β₁ ⊢σF ⊢σG ⊢σt ⊢σu)
  in  proj₂ (redSubstTermᵛ {F} {fst (prod t u)} {t} [Γ] fst⇒t [F] [t])

Σ-β₂ᵛ : ∀ {F G t u Γ l}
        ([Γ] : ⊩ᵛ Γ)
        ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ])
        ([G] : Γ ∙ F ⊩ᵛ⟨ l ⟩ G / [Γ] ∙ [F])
        ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ F / [Γ] / [F])
        ([u] : Γ ⊩ᵛ⟨ l ⟩ u ∷ G [ t ] / [Γ] / substS {F} {G} [Γ] [F] [G] [t])
      → Γ ⊩ᵛ⟨ l ⟩ snd (prod t u) ≡ u ∷ G [ fst (prod t u) ] / [Γ]
          / substS {F} {G} [Γ] [F] [G]
                   (fstᵛ {F} {G} {prod t u} [Γ] [F] [G]
                         (prodᵛ {F} {G} {t} {u} [Γ] [F] [G] [t] [u]))
Σ-β₂ᵛ {F} {G} {t} {u} {Γ} {l} [Γ] [F] [G] [t] [u] =
  let [Gt] = substS {F} {G} {t} [Γ] [F] [G] [t]
      [prod] = prodᵛ {F} {G} {t} {u} [Γ] [F] [G] [t] [u]
      [fst] = fstᵛ {F} {G} {prod t u} [Γ] [F] [G] [prod]
      [Gfst] = substS {F} {G} {fst (prod t u)} [Γ] [F] [G] [fst]
      [fst≡t] = Σ-β₁ᵛ {F} {G} {t} {u} [Γ] [F] [G] [t] [u]
      [Gfst≡Gt] = substSEq {F} {F} {G} {G} {fst (prod t u)} {t}
                           [Γ] [F] [F] (reflᵛ {F} [Γ] [F])
                               [G] [G] (reflᵛ {G} {Γ ∙ F} ([Γ] ∙ [F]) [G])
                               [fst] [t] [fst≡t]

      [u]Gfst = conv₂ᵛ {u} {G [ fst (prod t u) ]} {G [ t ]}
                       [Γ] [Gfst] [Gt] [Gfst≡Gt] [u]

      snd⇒t : Γ ⊩ᵛ snd (prod t u) ⇒ u ∷ G [ fst (prod t u) ] / [Γ]
      snd⇒t = (λ {Δ} {σ} ⊢Δ [σ] →
                let ⊩σF = proj₁ ([F] ⊢Δ [σ])
                    ⊢σF = escape ⊩σF

                    [Fσ] = liftSubstS {F = F} {σ = σ} [Γ] ⊢Δ [F] [σ]
                    ⊩σG : Δ ∙ subst σ F ⊩⟨ l ⟩ subst (liftSubst σ) G
                    ⊩σG = proj₁ ([G] (⊢Δ ∙ ⊢σF) [Fσ])
                    ⊢σG = escape ⊩σG

                    ⊩σt = proj₁ ([t] ⊢Δ [σ])
                    ⊢σt = escapeTerm ⊩σF ⊩σt

                    ⊩σGt₁ = proj₁ ([Gt] ⊢Δ [σ])
                    ⊩σGt = irrelevance′ (singleSubstLift G t) ⊩σGt₁

                    ⊩σu₁ = proj₁ ([u] ⊢Δ [σ])
                    ⊩σu = irrelevanceTerm′ (singleSubstLift G t) ⊩σGt₁ ⊩σGt ⊩σu₁
                    ⊢σu = escapeTerm ⊩σGt ⊩σu

                    snd⇒t : Δ ⊢ _ ⇒ _ ∷ _
                    snd⇒t = Σ-β₂ ⊢σF ⊢σG ⊢σt ⊢σu
                    σGfst≡σGfst = PE.subst (λ x → Δ ⊢ x ≡ subst σ (G [ fst (prod t u) ]))
                                           (singleSubstLift G (fst (prod t u)))
                                           (refl (escape (proj₁ ([Gfst] ⊢Δ [σ]))))
              in  conv snd⇒t σGfst≡σGfst)
  in  proj₂ (redSubstTermᵛ {G [ fst (prod t u) ]} {snd (prod t u)} {u} [Γ] snd⇒t [Gfst] [u]Gfst)

Σ-η′ : ∀ {F G p r Γ l l′}
         ([F] : Γ ⊩⟨ l′ ⟩ F)
         ([Gfstp] : Γ ⊩⟨ l′ ⟩ G [ fst p ])
         ([ΣFG]₁ : Γ ⊩⟨ l ⟩B⟨ BΣ ⟩ Σ F ▹ G )
         ([p] : Γ ⊩⟨ l ⟩ p ∷ Σ F ▹ G / B-intr BΣ [ΣFG]₁)
         ([r] : Γ ⊩⟨ l ⟩ r ∷ Σ F ▹ G / B-intr BΣ [ΣFG]₁)
         ([fst≡] : Γ ⊩⟨ l′ ⟩ fst p ≡ fst r ∷ F / [F])
         ([snd≡] : Γ ⊩⟨ l′ ⟩ snd p ≡ snd r ∷ G [ fst p ] / [Gfstp])
       → Γ ⊩⟨ l ⟩ p ≡ r ∷ Σ F ▹ G / B-intr BΣ [ΣFG]₁
Σ-η′ {F} {G} {p} {r} {Γ} {l} {l′}
     [F] [Gfstp]
     [ΣFG]₁@(noemb (Bᵣ F₁ G₁ D ⊢F ⊢G A≡A [F]₁ [G]₁ G-ext))
     [p]@(Σₜ p′ dₚ p′Prod p′≅p′ wk[fstp′] wk[sndp′])
     [r]@(Σₜ r′ dᵣ r′Prod r′≅r′ wk[fstr′] wk[sndr′])
     [fst≡]
     [snd≡]
       with B-PE-injectivity BΣ (whnfRed* (red D) Σₙ)
... | PE.refl , PE.refl =
  let [ΣFG] = B-intr BΣ [ΣFG]₁
      ⊢Γ = wf ⊢F
      wk[F] = [F]₁ id ⊢Γ
      wk[Gfstp′] = [G]₁ id ⊢Γ wk[fstp′]

      fstp⇒* : Γ ⊢ fst p ⇒* fst p′ ∷ U.wk id F
      fstp⇒* = PE.subst (λ x → Γ ⊢ _ ⇒* _ ∷ x)
                        (PE.sym (wk-id F))
                        (fst-subst* ⊢F ⊢G (redₜ dₚ))
      fstr⇒* = PE.subst (λ x → Γ ⊢ _ ⇒* _ ∷ x)
                        (PE.sym (wk-id F))
                        (fst-subst* ⊢F ⊢G (redₜ dᵣ))

      --wk[fstp≡] : Γ ⊩⟨ l ⟩ fst p ≡ fst p′ ∷ U.wk id F / wk[F]
      wk[fstp] , wk[fstp≡] = redSubst*Term fstp⇒* wk[F] wk[fstp′]
      wk[fstr] , wk[fstr≡] = redSubst*Term fstr⇒* wk[F] wk[fstr′]

      wk[fst≡] = irrelevanceEqTerm′ (PE.sym (wk-id F))
                                    [F] wk[F]
                                    [fst≡]
      wk[fst′≡] : Γ ⊩⟨ l ⟩ fst p′ ≡ fst r′ ∷ U.wk id F / wk[F]
      wk[fst′≡] = transEqTerm wk[F]
                             (symEqTerm wk[F] wk[fstp≡])
                             (transEqTerm wk[F] wk[fst≡] wk[fstr≡])

      [p′] : Γ ⊩⟨ l ⟩ p′ ∷ Σ F ▹ G / [ΣFG]
      [p′] = Σₜ p′ (idRedTerm:*: (⊢u-redₜ dₚ)) p′Prod p′≅p′ wk[fstp′] wk[sndp′]
      [r′] = Σₜ r′ (idRedTerm:*: (⊢u-redₜ dᵣ)) r′Prod r′≅r′ wk[fstr′] wk[sndr′]

      sndp⇒*₁ : Γ ⊢ snd p ⇒* snd p′ ∷ G [ fst p ]
      sndp⇒*₁ = snd-subst* [F] [ΣFG] [p′] (redₜ dₚ)
      sndr⇒*₁ = snd-subst* [F] [ΣFG] [r′] (redₜ dᵣ)

      wk[Gfstp] = [G]₁ id ⊢Γ wk[fstp]
      wk[Gfstr] = [G]₁ id ⊢Γ wk[fstr]
      [Gfstr] = irrelevance′ (PE.cong (λ x → x [ fst r ]) (wk-lift-id G)) wk[Gfstr]
      wk[Gfstr′] = [G]₁ id ⊢Γ wk[fstr′]

      [Gfstp≡wkGfstp′] : Γ ⊩⟨ l′ ⟩ G [ fst p ] ≡ U.wk (lift id) G [ fst p′ ] / [Gfstp]
      [Gfstp≡wkGfstp′] = irrelevanceEq′ (PE.cong (λ x → x [ fst p ]) (wk-lift-id G))
                                        ([G]₁ id ⊢Γ wk[fstp]) [Gfstp]
                                        (G-ext id ⊢Γ wk[fstp] wk[fstp′] wk[fstp≡])
      [Gfstr≡Gfstp] : Γ ⊩⟨ _ ⟩ G [ fst r ] ≡ G [ fst p ] / [Gfstr]
      [Gfstr≡Gfstp] = irrelevanceEq″ (PE.cong (λ x → x [ fst r ]) (wk-lift-id G))
                                     (PE.cong (λ x → x [ fst p ]) (wk-lift-id G))
                                     wk[Gfstr] [Gfstr]
                                     (symEq wk[Gfstp] wk[Gfstr]
                                            (G-ext id ⊢Γ wk[fstp] wk[fstr] wk[fst≡]))
      [Gfstr≡wkGfstp′] : Γ ⊩⟨ l ⟩ G [ fst r ] ≡ U.wk (lift id) G [ fst p′ ] / [Gfstr]
      [Gfstr≡wkGfstp′] = transEq [Gfstr] [Gfstp] wk[Gfstp′]
                                 [Gfstr≡Gfstp] [Gfstp≡wkGfstp′]
      [wkGfstr′≡wkGfstp′] : Γ ⊩⟨ l ⟩ U.wk (lift id) G [ fst r′ ] ≡ U.wk (lift id) G [ fst p′ ] / wk[Gfstr′]
      [wkGfstr′≡wkGfstp′] = G-ext id ⊢Γ wk[fstr′] wk[fstp′] (symEqTerm wk[F] wk[fst′≡])

      sndp⇒* : Γ ⊢ snd p ⇒* snd p′ ∷ U.wk (lift id) G [ fst p′ ]
      sndp⇒* = conv* sndp⇒*₁ (≅-eq (escapeEq [Gfstp] [Gfstp≡wkGfstp′]))
      sndr⇒* = conv* sndr⇒*₁ (≅-eq (escapeEq [Gfstr] [Gfstr≡wkGfstp′]))

      wk[sndp≡] : Γ ⊩⟨ l ⟩ snd p ≡ snd p′ ∷ U.wk (lift id) G [ fst p′ ] / wk[Gfstp′]
      wk[sndp≡] = proj₂ (redSubst*Term sndp⇒* wk[Gfstp′] wk[sndp′])
      wk[sndr≡] = proj₂ (redSubst*Term sndr⇒* wk[Gfstp′]
                                       (convTerm₁ wk[Gfstr′] wk[Gfstp′]
                                                  [wkGfstr′≡wkGfstp′]
                                                  wk[sndr′]))

      wk[snd≡] : Γ ⊩⟨ l ⟩ snd p ≡ snd r ∷ U.wk (lift id) G [ fst p′ ] / wk[Gfstp′]
      wk[snd≡] = convEqTerm₁ [Gfstp] wk[Gfstp′] [Gfstp≡wkGfstp′] [snd≡]

      wk[snd′≡] : Γ ⊩⟨ l ⟩ snd p′ ≡ snd r′ ∷ U.wk (lift id) G [ fst p′ ] / wk[Gfstp′]
      wk[snd′≡] = transEqTerm wk[Gfstp′]
                              (symEqTerm wk[Gfstp′] wk[sndp≡])
                              (transEqTerm wk[Gfstp′] wk[snd≡] wk[sndr≡])

      p′≅r′ : Γ ⊢ p′ ≅ r′ ∷ Σ F ▹ G
      p′≅r′ = ≅-Σ-η ⊢F ⊢G (⊢u-redₜ dₚ) (⊢u-redₜ dᵣ)
                    p′Prod r′Prod
                    (PE.subst (λ x → Γ ⊢ _ ≅ _ ∷ x)
                              (wk-id F)
                              (escapeTermEq wk[F] wk[fst′≡]))
                    (PE.subst (λ x → Γ ⊢ _ ≅ _ ∷ x [ fst p′ ])
                              (wk-lift-id G)
                              (escapeTermEq wk[Gfstp′] wk[snd′≡]))
  in  Σₜ₌ p′ r′ dₚ dᵣ p′Prod r′Prod
          p′≅r′ [p] [r]
          wk[fstp′]
          wk[fstr′]
          wk[fst′≡]
          wk[snd′≡]
Σ-η′ [F] [Gfst] (emb 0<1 x) = Σ-η′ [F] [Gfst] x

Σ-η″ : ∀ {F G p r Γ l}
        ([F] : Γ ⊩⟨ l ⟩ F)
        ([Gfst] : Γ ⊩⟨ l ⟩ G [ fst p ])
        ([ΣFG] : Γ ⊩⟨ l ⟩ Σ F ▹ G)
        ([p] : Γ ⊩⟨ l ⟩ p ∷ Σ F ▹ G / [ΣFG])
        ([r] : Γ ⊩⟨ l ⟩ r ∷ Σ F ▹ G / [ΣFG])
        ([fst≡] : Γ ⊩⟨ l ⟩ fst p ≡ fst r ∷ F / [F])
        ([snd≡] : Γ ⊩⟨ l ⟩ snd p ≡ snd r ∷ G [ fst p ] / [Gfst])
      → Γ ⊩⟨ l ⟩ p ≡ r ∷ Σ F ▹ G / [ΣFG]
Σ-η″ {F} {G} {t} {Γ} {l} [F] [Gfst] [ΣFG] [p] [r] [fst≡] [snd≡] =
  let [ΣFG]′ = B-intr BΣ (B-elim BΣ [ΣFG])
      [p]′ = irrelevanceTerm [ΣFG] [ΣFG]′ [p]
      [r]′ = irrelevanceTerm [ΣFG] [ΣFG]′ [r]
      [p≡]′ = Σ-η′ [F] [Gfst] (B-elim BΣ [ΣFG]) [p]′ [r]′ [fst≡] [snd≡]
  in  irrelevanceEqTerm [ΣFG]′ [ΣFG] [p≡]′

Σ-ηᵛ : ∀ {F G p r Γ l}
         ([Γ] : ⊩ᵛ Γ)
         ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ])
         ([G] : Γ ∙ F ⊩ᵛ⟨ l ⟩ G / [Γ] ∙ [F])
       → let [ΣFG] = Σᵛ {F} {G} [Γ] [F] [G] in
         ([p] : Γ ⊩ᵛ⟨ l ⟩ p ∷ Σ F ▹ G / [Γ] / [ΣFG])
         ([r] : Γ ⊩ᵛ⟨ l ⟩ r ∷ Σ F ▹ G / [Γ] / [ΣFG])
         ([fst≡] : Γ ⊩ᵛ⟨ l ⟩ fst p ≡ fst r ∷ F / [Γ] / [F])
       → let [Gfst] = substS {F} {G} [Γ] [F] [G] (fstᵛ {F} {G} {p} [Γ] [F] [G] [p]) in
         ([snd≡] : Γ ⊩ᵛ⟨ l ⟩ snd p ≡ snd r ∷ G [ fst p ] / [Γ] / [Gfst])
       → Γ ⊩ᵛ⟨ l ⟩ p ≡ r ∷ Σ F ▹ G / [Γ] / [ΣFG]
Σ-ηᵛ {F} {G} {p} {r} {Γ} {l} [Γ] [F] [G] [p] [r] [fst≡] [snd≡] {Δ} {σ} ⊢Δ [σ] =
  let [ΣFG] = Σᵛ {F} {G} [Γ] [F] [G]
      [Gfst] = substS {F} {G} [Γ] [F] [G] (fstᵛ {F} {G} {p} [Γ] [F] [G] [p])
      ⊩σF = proj₁ ([F] ⊢Δ [σ])
      ⊩σGfst₁ = proj₁ ([Gfst] ⊢Δ [σ])
      ⊩σGfst = irrelevance′ (singleSubstLift G (fst p)) ⊩σGfst₁
      ⊩σΣFG = proj₁ ([ΣFG] ⊢Δ [σ])
      ⊩σp = proj₁ ([p] ⊢Δ [σ])
      ⊩σr = proj₁ ([r] ⊢Δ [σ])
      σfst≡ = [fst≡] ⊢Δ [σ]
      σsnd≡₁ = [snd≡] ⊢Δ [σ]
      σsnd≡ = irrelevanceEqTerm′ (singleSubstLift G (fst p)) ⊩σGfst₁ ⊩σGfst σsnd≡₁
  in  Σ-η″ ⊩σF ⊩σGfst ⊩σΣFG ⊩σp ⊩σr σfst≡ σsnd≡


module Data.Maybe.Instance where

open import Class.Equality
open import Class.Monad
open import Data.Maybe
open import Data.Maybe.Properties

instance
  Maybe-Monad : ∀ {a} -> Monad (Maybe {a})
  Maybe-Monad = record { _>>=_ = λ x f → maybe f nothing x ; return = just }

  Maybe-Eq : ∀ {A} {{_ : Eq A}} → Eq (Maybe A)
  Maybe-Eq ⦃ record { _≟_ = _≟_ } ⦄ = record { _≟_ = ≡-dec _≟_ }

  Maybe-EqB : ∀ {A} {{_ : Eq A}} → EqB (Maybe A)
  Maybe-EqB = Eq→EqB


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

import Data.String.Base as String
{-# BUILTIN FROMSTRING String.toList #-}
open import Data.Nat using (ℕ; zero; suc)
open import Data.Bool using (Bool; true; false)
open import Data.Unit using (⊤; tt)
open import Data.Fin using (Fin; zero; suc) renaming (#_ to #'_)
open import Data.Product using (_,_)
open import Data.Vec using (Vec; []; _∷_)
open import Data.Vec.Relation.Unary.All using (All; []; _∷_)
open import Data.String
open import Relation.Binary.PropositionalEquality using (_≡_; refl)

import Level as L

open import PiCalculus.Syntax
open Scoped
open import PiCalculus.Semantics
open import PiCalculus.LinearTypeSystem.Algebras
open import PiCalculus.LinearTypeSystem.Algebras.Linear using (Linear)
open import PiCalculus.LinearTypeSystem.Algebras.Shared using (Shared)
open import PiCalculus.LinearTypeSystem.Algebras.Graded using (Graded)

module PiCalculus.Examples where
open Raw

variable
  n : ℕ

raw : Raw
raw = ⦅ν "x"⦆ (("x" ⦅ "y" ⦆ 𝟘) ∥ ("x" ⟨ "a" ⟩ 𝟘))

scoped : Scoped 1
scoped = ν (((#' 0) ⦅⦆ 𝟘) ⦃ "y" ⦄ ∥ ((#' 0) ⟨ #' 1 ⟩ 𝟘)) ⦃ "x" ⦄

_ : Conversion.fromRaw ("a" ∷ []) raw ≡ scoped
_ = refl

channel-over-channel₀ : Raw
channel-over-channel₀ = ⦅ν "x"⦆
                        ( ("x" ⦅ "r" ⦆ "r" ⦅ "p" ⦆ 𝟘)
                        ∥ (⦅ν "z"⦆ ("x" ⟨ "z" ⟩ "z" ⟨ "y" ⟩ 𝟘)))

channel-over-channel₁ : Raw
channel-over-channel₁ = ⦅ν "x"⦆ ⦅ν "z"⦆
                        ( ("x" ⦅ "r" ⦆ "r" ⦅ "p" ⦆ 𝟘)
                        ∥ ("x" ⟨ "z" ⟩ "z" ⟨ "y" ⟩ 𝟘))

channel-over-channel₂ : Raw
channel-over-channel₂ = ⦅ν "z"⦆ ⦅ν "x"⦆
                        ( ("x" ⦅ "r" ⦆ "r" ⦅ "p" ⦆ 𝟘)
                        ∥ ("x" ⟨ "z" ⟩ "z" ⟨ "y" ⟩ 𝟘))

channel-over-channel₃ : Raw
channel-over-channel₃ = ⦅ν "z"⦆ ⦅ν "x"⦆
                        ( ("z" ⦅ "p" ⦆ 𝟘)
                        ∥ ("z" ⟨ "y" ⟩ 𝟘))

channel-over-channel₄ : Raw
channel-over-channel₄ = ⦅ν "z"⦆ ⦅ν "x"⦆
                        (𝟘 ∥ 𝟘)

channel-over-channel₅ : Raw
channel-over-channel₅ = ⦅ν "z"⦆ ⦅ν "x"⦆ 𝟘

channel-over-channel₆ : Raw
channel-over-channel₆ = ⦅ν "z"⦆ 𝟘

channel-over-channel₇ : Raw
channel-over-channel₇ = 𝟘

_!_≅_ : ∀ {n} → Vec Name n → Raw → Raw → Set
_!_≅_ = Conversion.map₂ _≅_

_!_⇒_ : ∀ {n} → Vec Name n → Raw → Raw → Set
_!_⇒_ = Conversion.map₂ _⇒_

_ : ("y" ∷ []) ! channel-over-channel₀ ≅ channel-over-channel₁
_ = _ , ν-cong cong-symm stop scope-ext ((λ ()) , (λ ()) , tt)

_ : ("y" ∷ []) ! channel-over-channel₁ ≅ channel-over-channel₂
_ = _ , stop scope-scope-comm

_ : ("y" ∷ []) ! channel-over-channel₂ ⇒ channel-over-channel₃
_ = _ , res res comm

_ : ("y" ∷ []) ! channel-over-channel₃ ⇒ channel-over-channel₄
_ = _ , res res comm

_ : ("y" ∷ []) ! channel-over-channel₄ ≅ channel-over-channel₅
_ = _ , ν-cong ν-cong stop comp-end

_ : ("y" ∷ []) ! channel-over-channel₅ ≅ channel-over-channel₆
_ = _ , ν-cong stop scope-end

_ : ("y" ∷ []) ! channel-over-channel₆ ≅ channel-over-channel₇
_ = _ , stop scope-end

module Shared-Graded-Linear where
  data Grading : Set where
    sha gra lin : Grading

  pattern 0∙ = false
  pattern 1∙ = true

  QUANTIFIERS : Algebras
  Algebras.Idx QUANTIFIERS = Grading
  Algebras.∃Idx QUANTIFIERS = sha
  Algebras.Usage QUANTIFIERS sha = ⊤
  Algebras.Usage QUANTIFIERS gra = ℕ
  Algebras.Usage QUANTIFIERS lin = Bool
  Algebras.UsageAlgebra QUANTIFIERS sha = Shared
  Algebras.UsageAlgebra QUANTIFIERS gra = Graded
  Algebras.UsageAlgebra QUANTIFIERS lin = Linear

  open Algebras QUANTIFIERS hiding (ℓᵢ;ℓₒ;ℓ∅;ℓ#;0∙;1∙)
  open import PiCalculus.LinearTypeSystem QUANTIFIERS
  open import PiCalculus.LinearTypeSystem.ContextLemmas QUANTIFIERS

  _!_；[_]_⊢_▹_ : Vec Name n → PreCtx n → (idxs : Idxs n) → Ctx idxs → Raw → Ctx idxs → Set
  ctx ! γ ；[ idxs ] Γ ⊢ P ▹ Δ = Conversion.map (λ P' → γ ；[ idxs ] Γ ⊢ P' ▹ Δ) ctx P

  ω∙ : ⊤ ²
  ω∙ = tt , tt

  ℓ# : Bool ²
  ℓ# = true , true

  ℓᵢ : Bool ²
  ℓᵢ = true , false

  ℓₒ : Bool ²
  ℓₒ = false , true

  ℓ∅ : Bool ²
  ℓ∅ = false , false

  instance
    name : Name
    name = ""

  _ : ([] -, "y") ! [] -, 𝟙 ；[ [] -, sha ] [] -, ω∙ ⊢ channel-over-channel₀ ▹ ε
  _ = ν C[ 𝟙 ； ω∙ ] ℓᵢ {lin} 1∙
      (((here ) ⦅⦆ (here ⦅⦆ 𝟘)) ∥
            (ν 𝟙 ω∙ {lin} 1∙
                  ((there here) ⟨ here ⟩ (here ⟨ there there here ⟩ 𝟘))))

  _ : [] -, 𝟙 ；[ [] -, sha ] [] -, ω∙ ⊢ ν (((#' 0) ⟨ #' 1 ⟩ 𝟘) ∥ ((#' 0) ⦅⦆ 𝟘)) ▹ ε
  _ = ν 𝟙 ω∙ {lin} 1∙ ((# 0 ⟨ # 1 ⟩ 𝟘) ∥ (# 0 ⦅⦆ 𝟘))

  p : Scoped 1
  p = ν (((#' 0) ⦅⦆ ((#' 0) ⦅⦆ 𝟘)) ∥ (ν ((#' 1) ⟨ #' 0 ⟩ (#' 0) ⟨ #' 2 ⟩ 𝟘)))

  _ : [] -, 𝟙 ；[ [] -, sha ] [] -, ω∙ ⊢ p ▹ ε
  _ = ν C[ 𝟙 ； ω∙ ] {lin} ℓᵢ {lin} 1∙ (
           (here ⦅⦆ (here ⦅⦆ 𝟘)) ∥ (ν 𝟙 ω∙ 1∙ (there here ⟨ here ⟩ (here ⟨ there there here ⟩ 𝟘))))

  P : Scoped 2
  P = (ν (suc zero ⟨ zero ⟩ zero ⟨ suc (suc zero) ⟩ 𝟘)) ∥ (zero ⦅⦆ zero ⦅⦆ 𝟘)

  ⊢P : ∀ {n} → [] -, 𝟙 -, C[ C[ 𝟙 ； ω∙ ] ； ℓᵢ ] ；[ [] -, sha -, gra ] [] -, ω∙ -, (suc n , suc n) ⊢ P ▹ [] -, ω∙ -, (n , n)
  ⊢P = ν 𝟙 ω∙ {lin} 1∙ ((there here) ⟨ here ⟩ (here ⟨ there there here ⟩ 𝟘)) ∥ (here ⦅⦆ (here ⦅⦆ 𝟘))

  ⊢P∥P : [] -, 𝟙 ；[ [] -, sha ] [] -, ω∙ ⊢ ν (P ∥ P) ▹ ε
  ⊢P∥P = ν C[ 𝟙 ； ω∙ ] ℓᵢ 2 (⊢P ∥ ⊢P)

  sync : ∀ {n} → Fin n → Fin n → Fin n → Scoped n
  sync i0 i1 o =
    i0 ⦅⦆
    suc i1 ⦅⦆
    suc (suc o) ⟨ suc zero ⟩
    suc (suc o) ⟨ zero ⟩ 𝟘

  send : ∀ {n} → Fin n → Scoped n
  send c = ν (suc c ⟨ zero ⟩ 𝟘)

  recv : ∀ {n} → Fin n → Scoped n
  recv c = c ⦅⦆ (suc c ⦅⦆ 𝟘)

  example : Scoped 0
  example = ν ( (send zero)
              ∥ ν ( (send zero)
                  ∥ ν ( recv zero
                      ∥ sync (#' 2) (#' 1) (#' 0))))

  ⊢-send : ∀ {n} {γ : PreCtx n} {idxs : Idxs n} {Γ : Ctx idxs} {k l}
         → γ -, C[_；_] {idx = lin} (C[_；_] {idx = sha} 𝟙 ω∙) ℓ∅ ；[ idxs -, gra ] Γ -, (k , suc l) ⊢ send zero ▹ Γ -, (k , l)
  ⊢-send = ν _ _ 0∙ (there here ⟨ here ⟩ 𝟘)

  ⊢-recv : ∀ {n} {γ : PreCtx n} {idxs : Idxs n} {Γ : Ctx idxs} {t : Type} {k l}
         → γ -, (C[_；_] {idx = lin} t ℓ∅) ；[ idxs -, gra ] Γ -, (suc (suc l) , k) ⊢ recv zero ▹ Γ -, (l , k)
  ⊢-recv = here ⦅⦆ (there here ⦅⦆ 𝟘)

  ⊢-sync : ∀ {n} {γ : PreCtx n} {idxs : Idxs n} {Γ : Ctx idxs} {t : Type} {lx rx ly ry lz rz}
         → γ -, C[_；_] {idx = lin} t ℓ∅ -, C[ t ； ℓ∅ ] -, C[ t ； ℓ∅ ]
         ；[ idxs -, gra -, gra -, gra ]
         Γ -, (suc lx , rx) -, (suc ly , ry) -, (lz , suc (suc rz)) ⊢ sync (#' 2) (#' 1) (#' 0) ▹ Γ -, (lx , rx) -, (ly , ry) -, (lz , rz)
  ⊢-sync = (there (there here)) ⦅⦆
           (there (there here)) ⦅⦆
           (there (there here)) ⟨ there here ⟩
           (there (there here)) ⟨ here ⟩ 𝟘

  _ : [] ； [] ⊢ example ▹ []
  _ = ν _ _ _ ( ⊢-send
    ∥ ν _ _ _ ( ⊢-send
    ∥ ν _ _ _ ( ⊢-recv
    ∥ ⊢-sync )))

module Linear where
  QUANTIFIERS : Algebras
  Algebras.Idx QUANTIFIERS = ⊤
  Algebras.∃Idx QUANTIFIERS = tt
  Algebras.Usage QUANTIFIERS _ = Bool
  Algebras.UsageAlgebra QUANTIFIERS _ = Linear

  open Algebras QUANTIFIERS
  open import PiCalculus.LinearTypeSystem QUANTIFIERS
  open import PiCalculus.LinearTypeSystem.ContextLemmas QUANTIFIERS

  _ : [] -, C[ 𝟙 ； ℓᵢ ] -, 𝟙 ； [] -, ℓ# -, ℓ# ∋[ #' 1 ] C[ 𝟙 ； ℓᵢ ] ； ℓᵢ ▹ [] -, ℓₒ -, ℓ#
  _ = there here


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

open import Definition.Typed.EqualityRelation

module Definition.LogicalRelation.Substitution.MaybeEmbed {{eqrel : EqRelSet}} where
open EqRelSet {{...}}

open import Definition.LogicalRelation
open import Definition.LogicalRelation.Irrelevance
open import Definition.LogicalRelation.Properties
open import Definition.LogicalRelation.Substitution

open import Tools.Product

-- Any level can be embedded into the highest level (validity variant).
maybeEmbᵛ : ∀ {l A Γ}
            ([Γ] : ⊩ᵛ Γ)
          → Γ ⊩ᵛ⟨ l ⟩ A / [Γ]
          → Γ ⊩ᵛ⟨ ¹ ⟩ A / [Γ]
maybeEmbᵛ {⁰} [Γ] [A] ⊢Δ [σ] =
  let [σA]  = proj₁ ([A] ⊢Δ [σ])
      [σA]′ = maybeEmb (proj₁ ([A] ⊢Δ [σ]))
  in  [σA]′
  ,   (λ [σ′] [σ≡σ′] → irrelevanceEq [σA] [σA]′ (proj₂ ([A] ⊢Δ [σ]) [σ′] [σ≡σ′]))
maybeEmbᵛ {¹} [Γ] [A] = [A]

-- The lowest level can be embedded in any level (validity variant).
maybeEmbₛ′ : ∀ {l A Γ}
             ([Γ] : ⊩ᵛ Γ)
           → Γ ⊩ᵛ⟨ ⁰ ⟩ A / [Γ]
           → Γ ⊩ᵛ⟨ l ⟩ A / [Γ]
maybeEmbₛ′ {⁰} [Γ] [A] = [A]
maybeEmbₛ′ {¹} [Γ] [A] ⊢Δ [σ] =
  let [σA]  = proj₁ ([A] ⊢Δ [σ])
      [σA]′ = maybeEmb′ (proj₁ ([A] ⊢Δ [σ]))
  in  [σA]′
  ,   (λ [σ′] [σ≡σ′] → irrelevanceEq [σA] [σA]′ (proj₂ ([A] ⊢Δ [σ]) [σ′] [σ≡σ′]))