------------------------------------------------------------------------
-- The usage relation.
------------------------------------------------------------------------
import Graded.Modality
open import Graded.Usage.Restrictions
module Graded.Usage
  {a} {M : Set a}
  (open Graded.Modality M)
  (π : Modality)
  (R : Usage-restrictions π)
  where
open Modality π
open Usage-restrictions R
open import Graded.Context π
open import Graded.Context.Properties π
open import Graded.Mode π
open import Graded.Usage.Erased-matches
open import Graded.Usage.Restrictions.Instance R
open import Graded.Usage.Restrictions.Natrec π
open import Definition.Untyped M
open import Tools.Bool using (T; true; false)
open import Tools.Fin
open import Tools.Function
open import Tools.Nat using (Nat; 1+)
open import Tools.Product
open import Tools.PropositionalEquality
open import Tools.Relation
infix 10 _βΈ[_]_
private
  variable
    n l : Nat
    p q r : M
    Ξ³ Ξ³β² Ξ³β Ξ³β Ξ³β Ξ³β Ξ³β
 Ξ³β Ξ΄ Ξ· ΞΈ Ο : Conβ n
    A B F G : Term n
    t u v w z : Term n
    x : Fin n
    m mβ² : Mode
    b : BinderMode
    s : Strength
    em : Erased-matches
    nm : Natrec-mode
-- A view used in the implementation ofΒ β_β.
data ββ-view (A : Set a) (em : Erased-matches) : Set a where
  is-all      : em β‘ all β ββ-view A em
  is-some-yes : em β‘ some β A β ββ-view A em
  is-other    : em β€α΅α΅ some β (em β‘ some β Β¬ A) β ββ-view A em
opaque
  -- The view ββ-viewΒ AΒ em is inhabited if A is decided.
  ββ-view-inhabited : {A : Set a} β Dec A β β em β ββ-view A em
  ββ-view-inhabited _       all  = is-all refl
  ββ-view-inhabited (yes p) some = is-some-yes refl p
  ββ-view-inhabited (no p)  some = is-other _ (Ξ» _ β p)
  ββ-view-inhabited _       none = is-other _ (Ξ» ())
opaque
  -- An instantiation of ββ-view-inhabited used forΒ J.
  J-view : β p q m β ββ-view (p β‘ π Γ q β‘ π) (erased-matches-for-J m)
  J-view p q _ = ββ-view-inhabited (is-π? p Γ-dec is-π? q) _
opaque
  -- An instantiation of ββ-view-inhabited used forΒ K.
  K-view : β p m β ββ-view (p β‘ π) (erased-matches-for-K m)
  K-view p _ = ββ-view-inhabited (is-π? p) _
-- Modality context inference for natrec.
ββ-natrec :
  β¦ ok : Natrec-mode-supports-usage-inference nm β¦ β
  (p r : M) (Ξ³ Ξ΄ Ξ· : Conβ n) β Conβ n
ββ-natrec β¦ ok = Nr β¦ (has-nr) β¦ β¦ p r Ξ³ Ξ΄ Ξ· = nrαΆ β¦ has-nr β¦ p r Ξ³ Ξ΄ Ξ·
ββ-natrec β¦ ok = No-nr-glb has-GLB β¦ p r Ξ³ Ξ΄ Ξ· =
  let x , _ = has-GLB r π p
      Ο , _ = nrα΅’αΆ-has-GLBαΆ has-GLB r Ξ³ Ξ΄
  in  x Β·αΆ Ξ· +αΆ Ο
-- Modality context inference (for modalities with nr functions).
infix 50 β_β
mutual
  β_β :
    β¦ ok : Natrec-mode-supports-usage-inference natrec-mode β¦ β
    Term n β Mode β Conβ n
  β var x β m = παΆ , x β β m β
  β U _ β _ = παΆ
  β Ξ Ξ£β¨ _ β© p , q β· F βΉ G β m = β F β (m α΅Β· p) +αΆ tailβ (β G β m)
  β lam p t β m = tailβ (β t β m)
  β t ββ¨ p β© u β m = β t β m +αΆ p Β·αΆ β u β (m α΅Β· p)
  β prod π¨ p t u β m = p Β·αΆ β t β (m α΅Β· p) +αΆ β u β m
  β prod π€ p t u β m = p Β·αΆ β t β (m α΅Β· p) β§αΆ β u β m
  β fst p t β m = β t β m
  β snd p t β m = β t β m
  β prodrec r _ _ _ t u β m =
    r Β·αΆ β t β (m α΅Β· r) +αΆ tailβ (tailβ (β u β m))
  β β β _ = παΆ
  β zero β _ = παΆ
  β suc t β m = β t β m
  β natrec p _ r _ z s n β m =
    ββ-natrec p r (β z β m) (tailβ (tailβ (β s β m))) (β n β m)
  β Unit! β _ = παΆ
  β star! β _ = παΆ
  β unitrec _ p q A t u β m = p Β·αΆ β t β (m α΅Β· p) +αΆ β u β m
  β Empty β _ = παΆ
  β emptyrec p _ t β m = p Β·αΆ β t β (m α΅Β· p)
  β Id _ t u β m = case Id-erased? of Ξ» where
    (yes _) β παΆ
    (no _)  β β t β m +αΆ β u β m
  β rfl β _ = παΆ
  β J p q _ t B u v w β m with J-view p q m
  β¦ | is-all _        = β u β m
  β¦ | is-some-yes _ _ = Ο Β·αΆ (tailβ (tailβ (β B β m)) +αΆ β u β m)
  β¦ | is-other _ _    =
        Ο Β·αΆ
        (β t β m +αΆ tailβ (tailβ (β B β m)) +αΆ
         β u β m +αΆ β v β m +αΆ β w β m)
  β K p _ t B u v β m with K-view p m
  β¦ | is-all _        = β u β m
  β¦ | is-some-yes _ _ = Ο Β·αΆ (tailβ (β B β m) +αΆ β u β m)
  β¦ | is-other _ _    =
        Ο Β·αΆ (β t β m +αΆ tailβ (β B β m) +αΆ β u β m +αΆ β v β m)
  β []-cong _ _ _ _ _ β _ = παΆ
-- Well-usage of variables
data _β_β_  : (x : Fin n) (p : M) (Ξ³ : Conβ n) β Set a where
  here  :                       x0 β p β Ξ³ β p
  there : (h : x β p β Ξ³) β (x +1) β p β Ξ³ β q
-- Well-usage relation for terms.
--
-- The definition is partly based on Robert Atkey's "Syntax and
-- Semantics of Quantitative Type Theory".
--
-- There are several sets of usage rules for Id, J and K. One (where
-- Id-erased is not inhabited and erased-matches-for-J and
-- erased-matches-for-K are both equal to none) is based on the work
-- of Abel, Danielsson and Vezzosi on adding support for erasure to
-- cubical type theory, and is similar to the following Agda code:
--
--   {-# OPTIONS --erasure --safe --cubical-compatible #-}
--
--   data Id {@0 a} {@0 A : Set a} (x : A) : A β Set a where
--     refl : Id x x
--
--   J :
--     β {@0 a} {p} {@0 A : Set a} {x : A}
--     (P : β {y} β Id x y β Set p) β
--     P (refl {x = x}) β
--     {y : A} (xβ‘y : Id x y) β P xβ‘y
--   J _ r refl = r
--
-- Note that (at the time of writing) Agda rejects the code if one of
-- the non-erased arguments is made erased. In particular, "P" cannot
-- be made erased.
--
-- Another set of usage rules (where Id-erased is inhabited and
-- erased-matches-for-J and erased-matches-for-K are both equal to
-- all) is based on the following Agda code:
--
--   {-# OPTIONS --erasure --safe --with-K #-}
--
--   open import Agda.Builtin.Sigma
--
--   data Id {@0 a} {@0 A : Set a} (@0 x : A) : @0 A β Set a where
--     refl : Id x x
--
--   J :
--     β {@0 a p} {@0 A : Set a} {@0 x : A}
--     (@0 P : β {y} β Id x y β Set p) β
--     P (refl {x = x}) β
--     {@0 y : A} (@0 xβ‘y : Id x y) β P xβ‘y
--   J _ r refl = r
--
--   -- One variant of the K rule.
--
--   K :
--     β {@0 a p} {@0 A : Set a} {@0 x : A}
--     (@0 P : Id x x β Set p) β
--     P refl β
--     (@0 xβ‘x : Id x x) β P xβ‘x
--   K _ r refl = r
--
--   -- Another variant of the K rule, which can be defined using the
--   -- first variant.
--
--   Kβ² :
--     β {@0 a p} {@0 A : Set a}
--     (@0 P : β x β Id x x β Set p) β
--     (β x β P x refl) β
--     (x : A) (@0 xβ‘x : Id x x) β P x xβ‘x
--   Kβ² P r x xβ‘x = K (P x) (r x) xβ‘x
--
--   _ :
--     β {@0 a p} {@0 A : Set a}
--     (@0 P : β x β Id x x β Set p)
--     (r : β x β P x refl)
--     (x : A) β
--     Id (Kβ² P r x refl) (r x)
--   _ = Ξ» _ _ _ β refl
--
--   -- The first variant of the K rule can also be defined using the
--   -- second (and J).
--
--   Kβ³ :
--     β {@0 a p} {@0 A : Set a} {@0 x : A}
--     (@0 P : Id x x β Set p) β
--     P refl β
--     (@0 xβ‘x : Id x x) β P xβ‘x
--   Kβ³ P r xβ‘x =
--     J (Ξ» {y = eq} _ β P refl β P eq)
--       (Ξ» p β p)
--       (Kβ² (Ξ» x (xβ‘x : Id x x) β Id refl xβ‘x) (Ξ» _ β refl) _ xβ‘x)
--       r
--
--   _ :
--     β {@0 a p} {@0 A : Set a} {@0 x : A}
--     (@0 P : Id x x β Set p)
--     (r : P refl)
--     (@0 xβ‘x : Id x x) β
--     Id (Kβ³ P r refl) r
--   _ = Ξ» _ _ _ β refl
--
-- Note that the K rule is active in the Agda code. However, the
-- variant of the J rule with an erased motive P can be considered
-- also in the absence of the K rule.
--
-- Yet another set of usage rules (where erased-matches-for-J and
-- erased-matches-for-K are both equal to "some") provides an
-- alternative to []-cong. If πα΅ is allowed, then the given usage
-- rules for J more or less give the power of []-cong plus the "none"
-- variants of the usage rules forΒ J:
--
-- * Graded.Box-cong.[]-cong-J is a variant of []-cong defined
--   usingΒ J. This term former satisfies typing rules that are similar
--   to those for []-cong (see Graded.Box-cong), and if the "some"
--   variants of the usage rules for J are used, then the term former
--   satisfies a usage rule that is similar to []-congβ (see
--   Graded.Box-cong.βΈ[]-cong-J).
--
-- * Definition.Untyped.Erased.Jα΅ is a variant of J that is defined
--   using []-cong. If []-cong is allowed (which at the time of
--   writing implies that the modality is non-trivial, see
--   Definition.Typed.Restrictions.Type-restrictions.[]-congβΒ¬Trivial),
--   then this term former satisfies typing rules that are similar to
--   those forΒ J (see Definition.Typed.Properties.Admissible.Erased).
--   Furthermore the term former satisfies a usage rule that is
--   similar to Jβββ if πα΅ is allowed (see
--   Graded.Derived.Erased.Usage.βΈJα΅).
--
-- The "some" variants of the usage rules for K were included to
-- mirror the rules forΒ J, but if the K rule is available, then it
-- might be a better idea to use the "all" rules.
data _βΈ[_]_ {n : Nat} : (Ξ³ : Conβ n) β Mode β Term n β Set a where
  sub       : Ξ³ βΈ[ m ] t
            β Ξ΄ β€αΆ Ξ³
            β Ξ΄ βΈ[ m ] t
  var       : (παΆ , x β β m β) βΈ[ m ] var x
  Uβ        : παΆ βΈ[ m ] U l
  Emptyβ    : παΆ βΈ[ m ] Empty
  emptyrecβ : Ξ³ βΈ[ m α΅Β· p ] t
            β Ξ΄ βΈ[ πα΅? ] A
            β Emptyrec-allowed m p
            β p Β·αΆ Ξ³ βΈ[ m ] emptyrec p A t
  Unitβ     : παΆ βΈ[ m ] Unit s l
  -- If strong unit types are not allowed to be used as sinks, then Ξ³
  -- must beΒ παΆ.
  starΛ’β    : (Β¬ StarΛ’-sink β παΆ βαΆ Ξ³)
            β β m β Β·αΆ Ξ³ βΈ[ m ] starΛ’ l
  starΚ·β    : παΆ βΈ[ m ] starΚ· l
  unitrecβ : Ξ³ βΈ[ m α΅Β· p ] t
           β Ξ΄ βΈ[ m ] u
           β Ξ· β β πα΅? β Β· q βΈ[ πα΅? ] A
           β Unitrec-allowed m p q
           β p Β·αΆ Ξ³ +αΆ Ξ΄ βΈ[ m ] unitrec l p q A t u
  Ξ Ξ£β       : Ξ³ βΈ[ m α΅Β· p ] F
            β Ξ΄ β β m β Β· q βΈ[ m ] G
            β Ξ³ +αΆ Ξ΄ βΈ[ m ] Ξ Ξ£β¨ b β© p , q β· F βΉ G
  lamβ      : Ξ³ β β m β Β· p βΈ[ m ] t
            β Ξ³ βΈ[ m ] lam p t
  _ββ_      : Ξ³ βΈ[ m ] t
            β Ξ΄ βΈ[ m α΅Β· p ] u
            β Ξ³ +αΆ p Β·αΆ Ξ΄ βΈ[ m ] t ββ¨ p β© u
  prodΛ’β   : Ξ³ βΈ[ m α΅Β· p ] t
           β Ξ΄ βΈ[ m ] u
           β p Β·αΆ Ξ³ β§αΆ Ξ΄ βΈ[ m ] prodΛ’ p t u
  -- Note that either pΒ β€Β π or mβ²Β β‘Β πα΅
  fstβ      : β m
            β Ξ³ βΈ[ m α΅Β· p ] t
            β m α΅Β· p β‘ mβ²
            β (mβ² β‘ πα΅ β p β€ π)
            β Ξ³ βΈ[ mβ² ] fst p t
  sndβ      : Ξ³ βΈ[ m ] t
            β Ξ³ βΈ[ m ] snd p t
  prodΚ·β    : Ξ³ βΈ[ m α΅Β· p ] t
            β Ξ΄ βΈ[ m ] u
            β p Β·αΆ Ξ³ +αΆ Ξ΄ βΈ[ m ] prodΚ· p t u
  prodrecβ  : Ξ³ βΈ[ m α΅Β· r ] t
            β Ξ΄ β β m β Β· r Β· p β β m β Β· r βΈ[ m ] u
            β Ξ· β β πα΅? β Β· q βΈ[ πα΅? ] A
            β Prodrec-allowed m r p q
            β r Β·αΆ Ξ³ +αΆ Ξ΄ βΈ[ m ] prodrec r p q A t u
  ββ        : παΆ βΈ[ m ] β
  zeroβ     : παΆ βΈ[ m ] zero
  sucβ      : Ξ³ βΈ[ m ] t
            β Ξ³ βΈ[ m ] suc t
  -- A usage rule for natrec which applies if a dedicated nr function
  -- ("natrec usage function") is available.
  natrecβ   : β {s n} β¦ has-nr : Nr-available β¦
            β Ξ³ βΈ[ m ] z
            β Ξ΄ β β m β Β· p β β m β Β· r βΈ[ m ] s
            β Ξ· βΈ[ m ] n
            β ΞΈ β β πα΅? β Β· q βΈ[ πα΅? ] A
            β nrαΆ p r Ξ³ Ξ΄ Ξ· βΈ[ m ] natrec p q r A z s n
  -- A usage rule for natrec which applies if a dedicated nr function
  -- is not available.
  --
  -- There are four inequality assumptions:
  --
  -- * Two are always required to hold. These assumptions are (at the
  --   time of writing) for instance used to prove the natrec-zero and
  --   natrec-suc cases of the subject reduction lemma
  --   Graded.Reduction.usagePresTerm.
  --
  -- * The assumption ΟΒ β€αΆΒ Ξ· is only required to hold if the
  --   modality's zero is well-behaved. This assumption is (at the
  --   time of writing) used, together with the two unrestricted
  --   assumptions, to prove the fundamental lemma
  --   Graded.Erasure.LogicalRelation.Fundamental.Fundamental.fundamental
  --   (among other things). The statement of this lemma includes the
  --   assumption that the modality's zero is well-behaved.
  --
  -- * The assumption ΟΒ β€αΆΒ Ξ΄ is only required to hold if πα΅ is
  --   allowed. This assumption is used to prove the substitution
  --   lemma Graded.Substitution.Properties.substβ-lemma.
  --
  -- Note that this rule may not always be appropriate. See
  -- Graded.Modality.Instances.Linearity.Examples.Bad.No-nr,
  -- Graded.Modality.Instances.Affine.Examples.Bad.No-nr and
  -- Graded.Modality.Instances.Linear-or-affine.Examples.Bad.No-nr
  -- for some examples.
  natrec-no-nrβ :
            β {n s} β¦ no-nr : Nr-not-available β¦
            β Ξ³ βΈ[ m ] z
            β Ξ΄ β β m β Β· p β β m β Β· r βΈ[ m ] s
            β Ξ· βΈ[ m ] n
            β ΞΈ β β πα΅? β Β· q βΈ[ πα΅? ] A
            β Ο β€αΆ Ξ³
            β (T πα΅-allowed β
               Ο β€αΆ Ξ΄)
            β (β¦ π-well-behaved :
                   Has-well-behaved-zero semiring-with-meet β¦ β
               Ο β€αΆ Ξ·)
            β Ο β€αΆ Ξ΄ +αΆ p Β·αΆ Ξ· +αΆ r Β·αΆ Ο
            β Ο βΈ[ m ] natrec p q r A z s n
  -- Another usage rule for natrec which applies if a dedicated nr function
  -- is not available.
  --
  -- The usage count of natrec is assumed to consist of one part representing
  -- the usage contributions of the natural number and one part representing
  -- the usage contributions of the zero and successor cases.
  --
  -- The contribution of the natural number argument is given by the greatest
  -- lower bound of the sequence nrα΅’Β rΒ πΒ p. The elements of the sequence
  -- represents the usage count of the natural number for a given number of
  -- unfoldings.
  -- When the natural number argument is zero the natural number argument is used
  -- once (for matching). This is represented by nrβΒ rΒ πΒ pΒ β‘Β π. When the natural
  -- number argument is sucΒ n, the argument is used p times (by the successor case)
  -- plus an additional number of times in the recursive call. Assuming a
  -- suitable substitution lemma, the total usage counts become pΒ +Β rΒ Β·Β nrα΅’Β rΒ πΒ p
  -- where nrα΅’Β rΒ πΒ p is the usage count of the recursive call (being unfolded
  -- one time less). The greatest lower bound of all these usage counts is
  -- then compatible with all possible unfoldings (via subsumption)
  --
  -- The contribution of the zero and successor cases is similarly given by
  -- the greatest lower bound of the sequence nrα΅’αΆΒ rΒ Ξ³Β Ξ΄. As before, each
  -- element of the sequence corresponds to the total usage count for a given
  -- number of unfoldings.
  natrec-no-nr-glbβ :
           β {n s x} β¦ no-nr : Nr-not-available-GLB β¦
           β Ξ³ βΈ[ m ] z
           β Ξ΄ β β m β Β· p β β m β Β· r βΈ[ m ] s
           β Ξ· βΈ[ m ] n
           β ΞΈ β β πα΅? β Β· q βΈ[ πα΅? ] A
           β Greatest-lower-bound x (nrα΅’ r π p)
           β Greatest-lower-boundαΆ Ο (nrα΅’αΆ r Ξ³ Ξ΄)
           β x Β·αΆ Ξ· +αΆ Ο βΈ[ m ] natrec p q r A z s n
  Idβ       : Β¬ Id-erased
            β Ξ³ βΈ[ πα΅? ] A
            β Ξ΄ βΈ[ m ] t
            β Ξ· βΈ[ m ] u
            β Ξ΄ +αΆ Ξ· βΈ[ m ] Id A t u
  Idββ      : Id-erased
            β Ξ³ βΈ[ πα΅? ] A
            β Ξ΄ βΈ[ πα΅? ] t
            β Ξ· βΈ[ πα΅? ] u
            β παΆ βΈ[ m ] Id A t u
  rflβ      : παΆ βΈ[ m ] rfl
  Jβ        : erased-matches-for-J m β€α΅α΅ some
            β (erased-matches-for-J m β‘ some β Β¬ (p β‘ π Γ q β‘ π))
            β Ξ³β βΈ[ πα΅? ] A
            β Ξ³β βΈ[ m ] t
            β Ξ³β β β m β Β· p β β m β Β· q βΈ[ m ] B
            β Ξ³β βΈ[ m ] u
            β Ξ³β
 βΈ[ m ] v
            β Ξ³β βΈ[ m ] w
            β Ο Β·αΆ (Ξ³β +αΆ Ξ³β +αΆ Ξ³β +αΆ Ξ³β
 +αΆ Ξ³β) βΈ[ m ] J p q A t B u v w
  Jβββ      : erased-matches-for-J m β‘ some
            β p β‘ π
            β q β‘ π
            β Ξ³β βΈ[ πα΅? ] A
            β Ξ³β βΈ[ πα΅? ] t
            β Ξ³β β π β π βΈ[ m ] B
            β Ξ³β βΈ[ m ] u
            β Ξ³β
 βΈ[ πα΅? ] v
            β Ξ³β βΈ[ πα΅? ] w
            β Ο Β·αΆ (Ξ³β +αΆ Ξ³β) βΈ[ m ] J p q A t B u v w
  Jβββ      : erased-matches-for-J m β‘ all
            β Ξ³β βΈ[ πα΅? ] A
            β Ξ³β βΈ[ πα΅? ] t
            β Ξ³β β β πα΅? β Β· p β β πα΅? β Β· q βΈ[ πα΅? ] B
            β Ξ³β βΈ[ m ] u
            β Ξ³β
 βΈ[ πα΅? ] v
            β Ξ³β βΈ[ πα΅? ] w
            β Ξ³β βΈ[ m ] J p q A t B u v w
  Kβ        : erased-matches-for-K m β€α΅α΅ some
            β (erased-matches-for-K m β‘ some β p β’ π)
            β Ξ³β βΈ[ πα΅? ] A
            β Ξ³β βΈ[ m ] t
            β Ξ³β β β m β Β· p βΈ[ m ] B
            β Ξ³β βΈ[ m ] u
            β Ξ³β
 βΈ[ m ] v
            β Ο Β·αΆ (Ξ³β +αΆ Ξ³β +αΆ Ξ³β +αΆ Ξ³β
) βΈ[ m ] K p A t B u v
  Kβββ      : erased-matches-for-K m β‘ some
            β p β‘ π
            β Ξ³β βΈ[ πα΅? ] A
            β Ξ³β βΈ[ πα΅? ] t
            β Ξ³β β π βΈ[ m ] B
            β Ξ³β βΈ[ m ] u
            β Ξ³β
 βΈ[ πα΅? ] v
            β Ο Β·αΆ (Ξ³β +αΆ Ξ³β) βΈ[ m ] K p A t B u v
  Kβββ      : erased-matches-for-K m β‘ all
            β Ξ³β βΈ[ πα΅? ] A
            β Ξ³β βΈ[ πα΅? ] t
            β Ξ³β β β πα΅? β Β· p βΈ[ πα΅? ] B
            β Ξ³β βΈ[ m ] u
            β Ξ³β
 βΈ[ πα΅? ] v
            β Ξ³β βΈ[ m ] K p A t B u v
  []-congβ  : Ξ³β βΈ[ πα΅? ] A
            β Ξ³β βΈ[ πα΅? ] t
            β Ξ³β βΈ[ πα΅? ] u
            β Ξ³β βΈ[ πα΅? ] v
            β []-cong-allowed-mode s m
            β παΆ βΈ[ m ] []-cong s A t u v
-- Usage with implicit mode πα΅
_βΈ_ : (Ξ³ : Conβ n) (t : Term n) β Set a
Ξ³ βΈ t = Ξ³ βΈ[ πα΅ ] t
starβ : παΆ {n} βΈ[ m ] star s l
starβ {s = π€} =
  sub (starΛ’β Ξ» _ β βαΆ-refl)
      (β€αΆ-reflexive (βαΆ-sym (Β·αΆ-zeroΚ³ _)))
starβ {s = π¨} = starΚ·β