------------------------------------------------------------------------
-- A modality for affine types.
------------------------------------------------------------------------

open import Tools.Bool
open import Tools.Level

open import Graded.Modality.Instances.Zero-one-many true as πŸ˜πŸ™Ο‰
open import Graded.Modality.Variant lzero

module Graded.Modality.Instances.Affine
  -- The modality variant.
  (variant : Modality-variant)
  where

open Modality-variant variant

open πŸ˜πŸ™Ο‰ renaming (Zero-one-many to Affine) public

open import Graded.Modality Affine
import Graded.Modality.Properties
open import Graded.FullReduction.Assumptions
import Graded.Usage.Restrictions

import Definition.Typed.Restrictions
open import Definition.Untyped

open import Tools.Empty
open import Tools.Function
open import Tools.Product
open import Tools.PropositionalEquality
open import Tools.Relation
open import Tools.Sum
open import Tools.Unit

private variable
  p  : Affine

-- An "affine types" modality.

affineModality : Modality
affineModality = zero-one-many-modality variant

open Definition.Typed.Restrictions affineModality
open Graded.Modality.Properties    affineModality
open Graded.Usage.Restrictions     affineModality

private variable
  rs : Type-restrictions
  us : Usage-restrictions

-- An alternative (not very good) "affine types" modality.
--
-- See Graded.Modality.Instances.Affine.Bad for an example that
-- illustrates in what sense this modality is not very good. The
-- modality affineModality does not suffer from this problem (see
-- Graded.Modality.Instances.Affine.Good), but note that, at the time
-- of writing, this formalisation does not contain any solid evidence
-- showing that affineModality captures a good notion of "affine
-- type".

bad-affine-modality : Modality
bad-affine-modality = zero-one-many-greatest variant

-- The nr function obtained from bad-affine-modality (if any) is
-- strictly greater than the one obtained from affineModality.

alternative-greater :
  (nr-available : Nr-available) β†’
  let nr₁ = affineModality
              .Modality.has-nr nr-available .Has-nr.nr
      nrβ‚‚ = bad-affine-modality
              .Modality.has-nr nr-available .Has-nr.nr
  in
  (βˆƒβ‚… Ξ» p r z s n β†’ Β¬ nr₁ p r z s n ≑ nrβ‚‚ p r z s n) Γ—
  (βˆ€ p r z s n β†’ nr₁ p r z s n ≀ nrβ‚‚ p r z s n)
alternative-greater _ =
    (𝟘 , πŸ™ , πŸ™ , 𝟘 , πŸ™ , (Ξ» ()))
  , Ξ» where
      𝟘 𝟘 𝟘 𝟘 𝟘 β†’ refl
      𝟘 𝟘 𝟘 𝟘 πŸ™ β†’ refl
      𝟘 𝟘 𝟘 𝟘 Ο‰ β†’ refl
      𝟘 𝟘 𝟘 πŸ™ 𝟘 β†’ refl
      𝟘 𝟘 𝟘 πŸ™ πŸ™ β†’ refl
      𝟘 𝟘 𝟘 πŸ™ Ο‰ β†’ refl
      𝟘 𝟘 𝟘 Ο‰ 𝟘 β†’ refl
      𝟘 𝟘 𝟘 Ο‰ πŸ™ β†’ refl
      𝟘 𝟘 𝟘 Ο‰ Ο‰ β†’ refl
      𝟘 𝟘 πŸ™ 𝟘 𝟘 β†’ refl
      𝟘 𝟘 πŸ™ 𝟘 πŸ™ β†’ refl
      𝟘 𝟘 πŸ™ 𝟘 Ο‰ β†’ refl
      𝟘 𝟘 πŸ™ πŸ™ 𝟘 β†’ refl
      𝟘 𝟘 πŸ™ πŸ™ πŸ™ β†’ refl
      𝟘 𝟘 πŸ™ πŸ™ Ο‰ β†’ refl
      𝟘 𝟘 πŸ™ Ο‰ 𝟘 β†’ refl
      𝟘 𝟘 πŸ™ Ο‰ πŸ™ β†’ refl
      𝟘 𝟘 πŸ™ Ο‰ Ο‰ β†’ refl
      𝟘 𝟘 Ο‰ 𝟘 𝟘 β†’ refl
      𝟘 𝟘 Ο‰ 𝟘 πŸ™ β†’ refl
      𝟘 𝟘 Ο‰ 𝟘 Ο‰ β†’ refl
      𝟘 𝟘 Ο‰ πŸ™ 𝟘 β†’ refl
      𝟘 𝟘 Ο‰ πŸ™ πŸ™ β†’ refl
      𝟘 𝟘 Ο‰ πŸ™ Ο‰ β†’ refl
      𝟘 𝟘 Ο‰ Ο‰ 𝟘 β†’ refl
      𝟘 𝟘 Ο‰ Ο‰ πŸ™ β†’ refl
      𝟘 𝟘 Ο‰ Ο‰ Ο‰ β†’ refl
      𝟘 πŸ™ 𝟘 𝟘 𝟘 β†’ refl
      𝟘 πŸ™ 𝟘 𝟘 πŸ™ β†’ refl
      𝟘 πŸ™ 𝟘 𝟘 Ο‰ β†’ refl
      𝟘 πŸ™ 𝟘 πŸ™ 𝟘 β†’ refl
      𝟘 πŸ™ 𝟘 πŸ™ πŸ™ β†’ refl
      𝟘 πŸ™ 𝟘 πŸ™ Ο‰ β†’ refl
      𝟘 πŸ™ 𝟘 Ο‰ 𝟘 β†’ refl
      𝟘 πŸ™ 𝟘 Ο‰ πŸ™ β†’ refl
      𝟘 πŸ™ 𝟘 Ο‰ Ο‰ β†’ refl
      𝟘 πŸ™ πŸ™ 𝟘 𝟘 β†’ refl
      𝟘 πŸ™ πŸ™ 𝟘 πŸ™ β†’ refl
      𝟘 πŸ™ πŸ™ 𝟘 Ο‰ β†’ refl
      𝟘 πŸ™ πŸ™ πŸ™ 𝟘 β†’ refl
      𝟘 πŸ™ πŸ™ πŸ™ πŸ™ β†’ refl
      𝟘 πŸ™ πŸ™ πŸ™ Ο‰ β†’ refl
      𝟘 πŸ™ πŸ™ Ο‰ 𝟘 β†’ refl
      𝟘 πŸ™ πŸ™ Ο‰ πŸ™ β†’ refl
      𝟘 πŸ™ πŸ™ Ο‰ Ο‰ β†’ refl
      𝟘 πŸ™ Ο‰ 𝟘 𝟘 β†’ refl
      𝟘 πŸ™ Ο‰ 𝟘 πŸ™ β†’ refl
      𝟘 πŸ™ Ο‰ 𝟘 Ο‰ β†’ refl
      𝟘 πŸ™ Ο‰ πŸ™ 𝟘 β†’ refl
      𝟘 πŸ™ Ο‰ πŸ™ πŸ™ β†’ refl
      𝟘 πŸ™ Ο‰ πŸ™ Ο‰ β†’ refl
      𝟘 πŸ™ Ο‰ Ο‰ 𝟘 β†’ refl
      𝟘 πŸ™ Ο‰ Ο‰ πŸ™ β†’ refl
      𝟘 πŸ™ Ο‰ Ο‰ Ο‰ β†’ refl
      𝟘 Ο‰ 𝟘 𝟘 𝟘 β†’ refl
      𝟘 Ο‰ 𝟘 𝟘 πŸ™ β†’ refl
      𝟘 Ο‰ 𝟘 𝟘 Ο‰ β†’ refl
      𝟘 Ο‰ 𝟘 πŸ™ 𝟘 β†’ refl
      𝟘 Ο‰ 𝟘 πŸ™ πŸ™ β†’ refl
      𝟘 Ο‰ 𝟘 πŸ™ Ο‰ β†’ refl
      𝟘 Ο‰ 𝟘 Ο‰ 𝟘 β†’ refl
      𝟘 Ο‰ 𝟘 Ο‰ πŸ™ β†’ refl
      𝟘 Ο‰ 𝟘 Ο‰ Ο‰ β†’ refl
      𝟘 Ο‰ πŸ™ 𝟘 𝟘 β†’ refl
      𝟘 Ο‰ πŸ™ 𝟘 πŸ™ β†’ refl
      𝟘 Ο‰ πŸ™ 𝟘 Ο‰ β†’ refl
      𝟘 Ο‰ πŸ™ πŸ™ 𝟘 β†’ refl
      𝟘 Ο‰ πŸ™ πŸ™ πŸ™ β†’ refl
      𝟘 Ο‰ πŸ™ πŸ™ Ο‰ β†’ refl
      𝟘 Ο‰ πŸ™ Ο‰ 𝟘 β†’ refl
      𝟘 Ο‰ πŸ™ Ο‰ πŸ™ β†’ refl
      𝟘 Ο‰ πŸ™ Ο‰ Ο‰ β†’ refl
      𝟘 Ο‰ Ο‰ 𝟘 𝟘 β†’ refl
      𝟘 Ο‰ Ο‰ 𝟘 πŸ™ β†’ refl
      𝟘 Ο‰ Ο‰ 𝟘 Ο‰ β†’ refl
      𝟘 Ο‰ Ο‰ πŸ™ 𝟘 β†’ refl
      𝟘 Ο‰ Ο‰ πŸ™ πŸ™ β†’ refl
      𝟘 Ο‰ Ο‰ πŸ™ Ο‰ β†’ refl
      𝟘 Ο‰ Ο‰ Ο‰ 𝟘 β†’ refl
      𝟘 Ο‰ Ο‰ Ο‰ πŸ™ β†’ refl
      𝟘 Ο‰ Ο‰ Ο‰ Ο‰ β†’ refl
      πŸ™ 𝟘 𝟘 𝟘 𝟘 β†’ refl
      πŸ™ 𝟘 𝟘 𝟘 πŸ™ β†’ refl
      πŸ™ 𝟘 𝟘 𝟘 Ο‰ β†’ refl
      πŸ™ 𝟘 𝟘 πŸ™ 𝟘 β†’ refl
      πŸ™ 𝟘 𝟘 πŸ™ πŸ™ β†’ refl
      πŸ™ 𝟘 𝟘 πŸ™ Ο‰ β†’ refl
      πŸ™ 𝟘 𝟘 Ο‰ 𝟘 β†’ refl
      πŸ™ 𝟘 𝟘 Ο‰ πŸ™ β†’ refl
      πŸ™ 𝟘 𝟘 Ο‰ Ο‰ β†’ refl
      πŸ™ 𝟘 πŸ™ 𝟘 𝟘 β†’ refl
      πŸ™ 𝟘 πŸ™ 𝟘 πŸ™ β†’ refl
      πŸ™ 𝟘 πŸ™ 𝟘 Ο‰ β†’ refl
      πŸ™ 𝟘 πŸ™ πŸ™ 𝟘 β†’ refl
      πŸ™ 𝟘 πŸ™ πŸ™ πŸ™ β†’ refl
      πŸ™ 𝟘 πŸ™ πŸ™ Ο‰ β†’ refl
      πŸ™ 𝟘 πŸ™ Ο‰ 𝟘 β†’ refl
      πŸ™ 𝟘 πŸ™ Ο‰ πŸ™ β†’ refl
      πŸ™ 𝟘 πŸ™ Ο‰ Ο‰ β†’ refl
      πŸ™ 𝟘 Ο‰ 𝟘 𝟘 β†’ refl
      πŸ™ 𝟘 Ο‰ 𝟘 πŸ™ β†’ refl
      πŸ™ 𝟘 Ο‰ 𝟘 Ο‰ β†’ refl
      πŸ™ 𝟘 Ο‰ πŸ™ 𝟘 β†’ refl
      πŸ™ 𝟘 Ο‰ πŸ™ πŸ™ β†’ refl
      πŸ™ 𝟘 Ο‰ πŸ™ Ο‰ β†’ refl
      πŸ™ 𝟘 Ο‰ Ο‰ 𝟘 β†’ refl
      πŸ™ 𝟘 Ο‰ Ο‰ πŸ™ β†’ refl
      πŸ™ 𝟘 Ο‰ Ο‰ Ο‰ β†’ refl
      πŸ™ πŸ™ 𝟘 𝟘 𝟘 β†’ refl
      πŸ™ πŸ™ 𝟘 𝟘 πŸ™ β†’ refl
      πŸ™ πŸ™ 𝟘 𝟘 Ο‰ β†’ refl
      πŸ™ πŸ™ 𝟘 πŸ™ 𝟘 β†’ refl
      πŸ™ πŸ™ 𝟘 πŸ™ πŸ™ β†’ refl
      πŸ™ πŸ™ 𝟘 πŸ™ Ο‰ β†’ refl
      πŸ™ πŸ™ 𝟘 Ο‰ 𝟘 β†’ refl
      πŸ™ πŸ™ 𝟘 Ο‰ πŸ™ β†’ refl
      πŸ™ πŸ™ 𝟘 Ο‰ Ο‰ β†’ refl
      πŸ™ πŸ™ πŸ™ 𝟘 𝟘 β†’ refl
      πŸ™ πŸ™ πŸ™ 𝟘 πŸ™ β†’ refl
      πŸ™ πŸ™ πŸ™ 𝟘 Ο‰ β†’ refl
      πŸ™ πŸ™ πŸ™ πŸ™ 𝟘 β†’ refl
      πŸ™ πŸ™ πŸ™ πŸ™ πŸ™ β†’ refl
      πŸ™ πŸ™ πŸ™ πŸ™ Ο‰ β†’ refl
      πŸ™ πŸ™ πŸ™ Ο‰ 𝟘 β†’ refl
      πŸ™ πŸ™ πŸ™ Ο‰ πŸ™ β†’ refl
      πŸ™ πŸ™ πŸ™ Ο‰ Ο‰ β†’ refl
      πŸ™ πŸ™ Ο‰ 𝟘 𝟘 β†’ refl
      πŸ™ πŸ™ Ο‰ 𝟘 πŸ™ β†’ refl
      πŸ™ πŸ™ Ο‰ 𝟘 Ο‰ β†’ refl
      πŸ™ πŸ™ Ο‰ πŸ™ 𝟘 β†’ refl
      πŸ™ πŸ™ Ο‰ πŸ™ πŸ™ β†’ refl
      πŸ™ πŸ™ Ο‰ πŸ™ Ο‰ β†’ refl
      πŸ™ πŸ™ Ο‰ Ο‰ 𝟘 β†’ refl
      πŸ™ πŸ™ Ο‰ Ο‰ πŸ™ β†’ refl
      πŸ™ πŸ™ Ο‰ Ο‰ Ο‰ β†’ refl
      πŸ™ Ο‰ 𝟘 𝟘 𝟘 β†’ refl
      πŸ™ Ο‰ 𝟘 𝟘 πŸ™ β†’ refl
      πŸ™ Ο‰ 𝟘 𝟘 Ο‰ β†’ refl
      πŸ™ Ο‰ 𝟘 πŸ™ 𝟘 β†’ refl
      πŸ™ Ο‰ 𝟘 πŸ™ πŸ™ β†’ refl
      πŸ™ Ο‰ 𝟘 πŸ™ Ο‰ β†’ refl
      πŸ™ Ο‰ 𝟘 Ο‰ 𝟘 β†’ refl
      πŸ™ Ο‰ 𝟘 Ο‰ πŸ™ β†’ refl
      πŸ™ Ο‰ 𝟘 Ο‰ Ο‰ β†’ refl
      πŸ™ Ο‰ πŸ™ 𝟘 𝟘 β†’ refl
      πŸ™ Ο‰ πŸ™ 𝟘 πŸ™ β†’ refl
      πŸ™ Ο‰ πŸ™ 𝟘 Ο‰ β†’ refl
      πŸ™ Ο‰ πŸ™ πŸ™ 𝟘 β†’ refl
      πŸ™ Ο‰ πŸ™ πŸ™ πŸ™ β†’ refl
      πŸ™ Ο‰ πŸ™ πŸ™ Ο‰ β†’ refl
      πŸ™ Ο‰ πŸ™ Ο‰ 𝟘 β†’ refl
      πŸ™ Ο‰ πŸ™ Ο‰ πŸ™ β†’ refl
      πŸ™ Ο‰ πŸ™ Ο‰ Ο‰ β†’ refl
      πŸ™ Ο‰ Ο‰ 𝟘 𝟘 β†’ refl
      πŸ™ Ο‰ Ο‰ 𝟘 πŸ™ β†’ refl
      πŸ™ Ο‰ Ο‰ 𝟘 Ο‰ β†’ refl
      πŸ™ Ο‰ Ο‰ πŸ™ 𝟘 β†’ refl
      πŸ™ Ο‰ Ο‰ πŸ™ πŸ™ β†’ refl
      πŸ™ Ο‰ Ο‰ πŸ™ Ο‰ β†’ refl
      πŸ™ Ο‰ Ο‰ Ο‰ 𝟘 β†’ refl
      πŸ™ Ο‰ Ο‰ Ο‰ πŸ™ β†’ refl
      πŸ™ Ο‰ Ο‰ Ο‰ Ο‰ β†’ refl
      Ο‰ 𝟘 𝟘 𝟘 𝟘 β†’ refl
      Ο‰ 𝟘 𝟘 𝟘 πŸ™ β†’ refl
      Ο‰ 𝟘 𝟘 𝟘 Ο‰ β†’ refl
      Ο‰ 𝟘 𝟘 πŸ™ 𝟘 β†’ refl
      Ο‰ 𝟘 𝟘 πŸ™ πŸ™ β†’ refl
      Ο‰ 𝟘 𝟘 πŸ™ Ο‰ β†’ refl
      Ο‰ 𝟘 𝟘 Ο‰ 𝟘 β†’ refl
      Ο‰ 𝟘 𝟘 Ο‰ πŸ™ β†’ refl
      Ο‰ 𝟘 𝟘 Ο‰ Ο‰ β†’ refl
      Ο‰ 𝟘 πŸ™ 𝟘 𝟘 β†’ refl
      Ο‰ 𝟘 πŸ™ 𝟘 πŸ™ β†’ refl
      Ο‰ 𝟘 πŸ™ 𝟘 Ο‰ β†’ refl
      Ο‰ 𝟘 πŸ™ πŸ™ 𝟘 β†’ refl
      Ο‰ 𝟘 πŸ™ πŸ™ πŸ™ β†’ refl
      Ο‰ 𝟘 πŸ™ πŸ™ Ο‰ β†’ refl
      Ο‰ 𝟘 πŸ™ Ο‰ 𝟘 β†’ refl
      Ο‰ 𝟘 πŸ™ Ο‰ πŸ™ β†’ refl
      Ο‰ 𝟘 πŸ™ Ο‰ Ο‰ β†’ refl
      Ο‰ 𝟘 Ο‰ 𝟘 𝟘 β†’ refl
      Ο‰ 𝟘 Ο‰ 𝟘 πŸ™ β†’ refl
      Ο‰ 𝟘 Ο‰ 𝟘 Ο‰ β†’ refl
      Ο‰ 𝟘 Ο‰ πŸ™ 𝟘 β†’ refl
      Ο‰ 𝟘 Ο‰ πŸ™ πŸ™ β†’ refl
      Ο‰ 𝟘 Ο‰ πŸ™ Ο‰ β†’ refl
      Ο‰ 𝟘 Ο‰ Ο‰ 𝟘 β†’ refl
      Ο‰ 𝟘 Ο‰ Ο‰ πŸ™ β†’ refl
      Ο‰ 𝟘 Ο‰ Ο‰ Ο‰ β†’ refl
      Ο‰ πŸ™ 𝟘 𝟘 𝟘 β†’ refl
      Ο‰ πŸ™ 𝟘 𝟘 πŸ™ β†’ refl
      Ο‰ πŸ™ 𝟘 𝟘 Ο‰ β†’ refl
      Ο‰ πŸ™ 𝟘 πŸ™ 𝟘 β†’ refl
      Ο‰ πŸ™ 𝟘 πŸ™ πŸ™ β†’ refl
      Ο‰ πŸ™ 𝟘 πŸ™ Ο‰ β†’ refl
      Ο‰ πŸ™ 𝟘 Ο‰ 𝟘 β†’ refl
      Ο‰ πŸ™ 𝟘 Ο‰ πŸ™ β†’ refl
      Ο‰ πŸ™ 𝟘 Ο‰ Ο‰ β†’ refl
      Ο‰ πŸ™ πŸ™ 𝟘 𝟘 β†’ refl
      Ο‰ πŸ™ πŸ™ 𝟘 πŸ™ β†’ refl
      Ο‰ πŸ™ πŸ™ 𝟘 Ο‰ β†’ refl
      Ο‰ πŸ™ πŸ™ πŸ™ 𝟘 β†’ refl
      Ο‰ πŸ™ πŸ™ πŸ™ πŸ™ β†’ refl
      Ο‰ πŸ™ πŸ™ πŸ™ Ο‰ β†’ refl
      Ο‰ πŸ™ πŸ™ Ο‰ 𝟘 β†’ refl
      Ο‰ πŸ™ πŸ™ Ο‰ πŸ™ β†’ refl
      Ο‰ πŸ™ πŸ™ Ο‰ Ο‰ β†’ refl
      Ο‰ πŸ™ Ο‰ 𝟘 𝟘 β†’ refl
      Ο‰ πŸ™ Ο‰ 𝟘 πŸ™ β†’ refl
      Ο‰ πŸ™ Ο‰ 𝟘 Ο‰ β†’ refl
      Ο‰ πŸ™ Ο‰ πŸ™ 𝟘 β†’ refl
      Ο‰ πŸ™ Ο‰ πŸ™ πŸ™ β†’ refl
      Ο‰ πŸ™ Ο‰ πŸ™ Ο‰ β†’ refl
      Ο‰ πŸ™ Ο‰ Ο‰ 𝟘 β†’ refl
      Ο‰ πŸ™ Ο‰ Ο‰ πŸ™ β†’ refl
      Ο‰ πŸ™ Ο‰ Ο‰ Ο‰ β†’ refl
      Ο‰ Ο‰ 𝟘 𝟘 𝟘 β†’ refl
      Ο‰ Ο‰ 𝟘 𝟘 πŸ™ β†’ refl
      Ο‰ Ο‰ 𝟘 𝟘 Ο‰ β†’ refl
      Ο‰ Ο‰ 𝟘 πŸ™ 𝟘 β†’ refl
      Ο‰ Ο‰ 𝟘 πŸ™ πŸ™ β†’ refl
      Ο‰ Ο‰ 𝟘 πŸ™ Ο‰ β†’ refl
      Ο‰ Ο‰ 𝟘 Ο‰ 𝟘 β†’ refl
      Ο‰ Ο‰ 𝟘 Ο‰ πŸ™ β†’ refl
      Ο‰ Ο‰ 𝟘 Ο‰ Ο‰ β†’ refl
      Ο‰ Ο‰ πŸ™ 𝟘 𝟘 β†’ refl
      Ο‰ Ο‰ πŸ™ 𝟘 πŸ™ β†’ refl
      Ο‰ Ο‰ πŸ™ 𝟘 Ο‰ β†’ refl
      Ο‰ Ο‰ πŸ™ πŸ™ 𝟘 β†’ refl
      Ο‰ Ο‰ πŸ™ πŸ™ πŸ™ β†’ refl
      Ο‰ Ο‰ πŸ™ πŸ™ Ο‰ β†’ refl
      Ο‰ Ο‰ πŸ™ Ο‰ 𝟘 β†’ refl
      Ο‰ Ο‰ πŸ™ Ο‰ πŸ™ β†’ refl
      Ο‰ Ο‰ πŸ™ Ο‰ Ο‰ β†’ refl
      Ο‰ Ο‰ Ο‰ 𝟘 𝟘 β†’ refl
      Ο‰ Ο‰ Ο‰ 𝟘 πŸ™ β†’ refl
      Ο‰ Ο‰ Ο‰ 𝟘 Ο‰ β†’ refl
      Ο‰ Ο‰ Ο‰ πŸ™ 𝟘 β†’ refl
      Ο‰ Ο‰ Ο‰ πŸ™ πŸ™ β†’ refl
      Ο‰ Ο‰ Ο‰ πŸ™ Ο‰ β†’ refl
      Ο‰ Ο‰ Ο‰ Ο‰ 𝟘 β†’ refl
      Ο‰ Ο‰ Ο‰ Ο‰ πŸ™ β†’ refl
      Ο‰ Ο‰ Ο‰ Ο‰ Ο‰ β†’ refl

instance

  -- The affine types" modality has a well-behaved zero.

  affine-has-well-behaved-zero :
    Has-well-behaved-zero (Modality.semiring-with-meet affineModality)
  affine-has-well-behaved-zero = zero-one-many-has-well-behaved-zero

-- 𝟘 is the largest element.

β‰€πŸ˜ : p ≀ 𝟘
β‰€πŸ˜ {p = 𝟘} = refl
β‰€πŸ˜ {p = πŸ™} = refl
β‰€πŸ˜ {p = Ο‰} = refl

-- An instance of Type-restrictions is suitable for the full reduction
-- theorem if
-- * Σ˒-allowed 𝟘 p implies that 𝟘ᡐ is allowed, and
-- * Ξ£Λ’-allowed ω p does not hold.

Suitable-for-full-reduction :
  Type-restrictions β†’ Set
Suitable-for-full-reduction rs =
  (βˆ€ p β†’ Ξ£Λ’-allowed 𝟘 p β†’ T 𝟘ᡐ-allowed) Γ—
  (βˆ€ p β†’ Β¬ Ξ£Λ’-allowed Ο‰ p)
  where
  open Type-restrictions rs

-- Given an instance of Type-restrictions one can create a "suitable"
-- instance.

suitable-for-full-reduction :
  Type-restrictions β†’ βˆƒ Suitable-for-full-reduction
suitable-for-full-reduction rs =
    record rs
      { Ξ Ξ£-allowed = Ξ» b p q β†’
          Ξ Ξ£-allowed b p q Γ—
          (b ≑ BMΞ£ 𝕀 Γ— p ≑ 𝟘 β†’ T 𝟘ᡐ-allowed) Γ—
          Β¬ (b ≑ BMΞ£ 𝕀 Γ— p ≑ Ο‰)
      ; []-cong-allowed = Ξ» s β†’
          []-cong-allowed s Γ— T 𝟘ᡐ-allowed
      ; []-congβ†’Erased = Ξ» (ok₁ , okβ‚‚) β†’
            []-congβ†’Erased ok₁ .proj₁ , []-congβ†’Erased ok₁ .projβ‚‚
          , (Ξ» _ β†’ okβ‚‚) , Ξ» ()
      ; []-cong→¬Trivial =
          𝟘ᡐ.non-trivial βˆ˜β†’ projβ‚‚
      }
  , (Ξ» _ β†’ (_$ (refl , refl)) βˆ˜β†’ proj₁ βˆ˜β†’ projβ‚‚)
  , (Ξ» _ β†’ (_$ (refl , refl)) βˆ˜β†’ projβ‚‚ βˆ˜β†’ projβ‚‚)
  where
  open Type-restrictions rs

-- The full reduction assumptions hold for affineModality and any
-- "suitable" Type-restrictions.

full-reduction-assumptions :
  Suitable-for-full-reduction rs β†’
  Full-reduction-assumptions rs us
full-reduction-assumptions (πŸ˜β†’πŸ˜α΅ , ¬ω) = record
  { sinkβŠŽπŸ™β‰€πŸ˜ = Ξ» _ _ β†’ injβ‚‚ refl
  ; β‰‘πŸ™βŠŽπŸ™β‰€πŸ˜   = Ξ» where
      {p = Ο‰} ok β†’ βŠ₯-elim (¬ω _ ok)
      {p = πŸ™} _  β†’ inj₁ refl
      {p = 𝟘} ok β†’ injβ‚‚ (refl , πŸ˜β†’πŸ˜α΅ _ ok , refl)
  }

-- Type and usage restrictions that satisfy the full reduction
-- assumptions are "suitable".

full-reduction-assumptions-suitable :
  Full-reduction-assumptions rs us β†’ Suitable-for-full-reduction rs
full-reduction-assumptions-suitable as =
    (Ξ» p Ξ£-ok β†’ case β‰‘πŸ™βŠŽπŸ™β‰€πŸ˜ Ξ£-ok of Ξ» where
      (inj₁ ())
      (injβ‚‚ (_ , 𝟘ᡐ-ok , _)) β†’ 𝟘ᡐ-ok)
  , Ξ» p Ξ£-ok β†’ case β‰‘πŸ™βŠŽπŸ™β‰€πŸ˜ Ξ£-ok of Ξ» where
      (inj₁ ())
      (injβ‚‚ (() , _))
  where
  open Full-reduction-assumptions as