module lemmas where

open import prelude
open import defns

postulate NH-CONG : ∀ {D} (H H′ : NavigationHistory(D)) → let open NavigationHistory H in let open NavigationHistory H′ using () renaming ( A to A′ ; Fo to Fo′ ; Eq to Eq′ ; FTO to FTO′ ) in (A ⊆ A′) → (A′ ⊆ A) → (Fo ≣ Fo′) → (Eq ≣ Eq′) → (FTO ≣ FTO′) → (H ≣ H′)

BT-hd : ∀ {D} {H : NavigationHistory(D)} {n} d (ds : D ^ n) →
  ((d ∷ ds) ∈ BackTarget*(H)) →
  (d ∈ BackTarget(H))
BT-hd {D} {H} {n} d ds d∷ds∈BT with Max-hd ((A ∪ JointSessionPast) ∩ CanGoBack) d ds d∷ds∈BT where open NavigationHistory H
BT-hd {D} {H} {n} d ds d∷ds∈BT | ((in₁ d∈A , d∈CGB), d-max′) = ((d∈A , d∈CGB) , d-max) where

  open NavigationHistory H

  d-max : ∀ e → (e ∈ (A ∩ CanGoBack) → (e ≤ d))
  d-max e (e∈A , e∈CGB) = d-max′ e ((in₁ e∈A) , e∈CGB)

BT-hd {D} {H} {n} d ds d∷ds∈BT | ((in₂ (a , (a∈A , (d<a , d~a))) , d∈CGB), d-max) = contradiction (<-impl-≱ d<a (d-max a ((in₁ a∈A) , (d , (d<a , d~a))))) where open NavigationHistory H

BT-tl : ∀ {D} {H : NavigationHistory(D)} {n} d d∈CGB (ds : D ^ n) →
  ((d ∷ ds) ∈ BackTarget*(H)) →
  (ds ∈ BackTarget*(H traverse-from d ∵ d∈CGB))
BT-tl {D} {H} {n} d d∈CGB ds d∷ds∈BT with Max-tl ((A ∪ JointSessionPast) ∩ CanGoBack) d ds d∷ds∈BT where open NavigationHistory H
BT-tl {D} {H} {n} d d∈CGB ds d∷ds∈BT | ((d>ds , (ds↓ , ds∈BT′)) , ds-max′) with max(SessionPast(d)) ∵ d∈CGB where open NavigationHistory H
BT-tl {D} {H} {n} d d∈CGB ds d∷ds∈BT | ((d>ds , (ds↓ , ds∈BT′)) , ds-max′) | (c , ((c<d , c~d) , c-max)) = ((ds↓ , ds∈BT) , ds-max) where

  open NavigationHistory H
  open NavigationHistory (H traverse-to c) using () renaming (A to A′ ; JointSessionPast to JointSessionPast′)

  d∈A : (d ∈ A)
  d∈A with BT-hd {H = H} d ds d∷ds∈BT
  d∈A | ((d∈A , _) , _) = d∈A

  d-max : ∀ e → (e ∈ (A ∩ CanGoBack) → (e ≤ d))
  d-max with BT-hd {H = H} d ds d∷ds∈BT
  d-max | ((_ , _) , d-max) = d-max

  lemma : (Past(d) ∩ ((A ∪ JointSessionPast) ∩ CanGoBack)) ⊆ ((A′ ∪ JointSessionPast′) ∩ CanGoBack)
  lemma e  (e<d , (_                              , e∈CGB)) with c ~? e
  lemma e  (e<d , (_                              , e∈CGB)) | in₁ c~e with ≤-total c e
  lemma e  (e<d , (_                              , e∈CGB)) | in₁ c~e | in₁ c≤e with ≤-asym c≤e (c-max e (e<d , ~-trans (~-sym c~e) c~d))
  lemma ._ (e<d , (_                              , e∈CGB)) | in₁ c~e | in₁ c≤e | refl = ((in₁ (in₂ refl)) , e∈CGB)
  lemma e  (e<d , (_                              , e∈CGB)) | in₁ c~e | in₂ e<c = (in₂ (_ , (in₂ refl , (e<c , ~-sym c~e))) , e∈CGB)
  lemma e  (e<d , (in₁ e∈A                        , e∈CGB)) | in₂ c≁e = ((in₁ (in₁ (c≁e , e∈A))) , e∈CGB)
  lemma e  (e<d , (in₂ (a , (a∈A ,  (e<a , e~a))) , e∈CGB)) | in₂ c≁e = (in₂ (a , (in₁ ((λ c~a → c≁e (~-trans c~a (~-sym e~a))) , a∈A) , (e<a , e~a))) , e∈CGB)

  lemma′ : ((A′ ∪ JointSessionPast′) ∩ CanGoBack) ⊆ ((A ∪ JointSessionPast) ∩ CanGoBack)
  lemma′ e  (in₁ (in₁ (c≁e , e∈A)) , e∈CGB) = ((in₁ e∈A) , e∈CGB)
  lemma′ ._ (in₁ (in₂ refl) , c∈CGB) = ((in₂ (d , (d∈A , (c<d , c~d)))) , c∈CGB)
  lemma′ e (in₂ (a , (in₁ (c≁a , a∈A) , e≲a)) , e∈CGB) = (in₂ (a , (a∈A , e≲a)) , e∈CGB)
  lemma′ e (in₂ (._ , (in₂ refl , e≲c)) , e∈CGB) = ((in₂ (d , (d∈A , ≲-trans e≲c (c<d , c~d)))) , e∈CGB)

  lemma″ : ((A′ ∪ JointSessionPast′) ∩ CanGoBack) ⊆ (Past(d))
  lemma″ e  (in₁ (in₁ (c≁e , e∈A)) , e∈CGB) = (d-max e (e∈A , e∈CGB) , (λ e≡d → c≁e (~-trans c~d (≡-impl-~ (sym e≡d)))))
  lemma″ ._ (in₁ (in₂ refl) , c∈CGB) = c<d
  lemma″ e (in₂ (a , (in₁ (c≁a , a∈A) , e≲a)) , e∈CGB) = <-trans-≤ (≲-impl-< e≲a) (d-max a (a∈A , (e , e≲a)))
  lemma″ e (in₂ (._ , (in₂ refl , (e<c , e~c))) , e∈CGB) = <-trans e<c c<d

  ds∈BT : ds ∈ All((A′ ∪ JointSessionPast′) ∩ CanGoBack)
  ds∈BT = All-resp-⊆ lemma ds (All-resp-∩ ds (d>ds , ds∈BT′))

  ds-max : ∀ es → (es ∈ (Decreasing ∩ All((A′ ∪ JointSessionPast′) ∩ CanGoBack))) → (es ≤* ds)
  ds-max es (es↓ , es∈BT′) = ds-max′ es (All-resp-⊆ lemma″ es es∈BT′ , (es↓ , All-resp-⊆ lemma′ es es∈BT′))

BT-nil :  ∀ {D} {H : NavigationHistory(D)} →
  (nil ∈ BackTarget*(H))
BT-nil = ((tt , tt) , λ { nil (tt , tt) → tt })

BT-cons : ∀ {D} {H : NavigationHistory(D)} {n} d d∈CGB (ds : D ^ n) →
  (d ∈ BackTarget(H)) →
  (ds ∈ BackTarget*(H traverse-from d ∵ d∈CGB)) →
  ((d ∷ ds) ∈ BackTarget*(H))
BT-cons {D} {H} d d∈CGB ds ((d∈A , _) , d-max) ((ds↓ , ds∈JSP′∩CGB) , ds-max) with max(SessionPast(d)) ∵ d∈CGB where open NavigationHistory H
BT-cons {D} {H} d d∈CGB ds ((d∈A , _) , d-max) ((ds↓ , ds∈JSP′∩CGB) , ds-max) | (c , ((c<d , c~d) , c-max)) = (((d<ds , ds↓) , (((in₁ d∈A) , d∈CGB) , All-resp-⊆ lemma′ ds ds∈JSP′∩CGB)) , d∷ds-max) where

  open NavigationHistory H
  open NavigationHistory (H traverse-to c) using () renaming (A to A′ ; JointSessionPast to JointSessionPast′)

  lemma : (Past(d) ∩ ((A ∪ JointSessionPast) ∩ CanGoBack)) ⊆ ((A′ ∪ JointSessionPast′) ∩ CanGoBack)
  lemma e  (e<d , (_                              , e∈CGB)) with c ~? e
  lemma e  (e<d , (_                              , e∈CGB)) | in₁ c~e with ≤-total c e
  lemma e  (e<d , (_                              , e∈CGB)) | in₁ c~e | in₁ c≤e with ≤-asym c≤e (c-max e (e<d , ~-trans (~-sym c~e) c~d))
  lemma ._ (e<d , (_                              , e∈CGB)) | in₁ c~e | in₁ c≤e | refl = ((in₁ (in₂ refl)) , e∈CGB)
  lemma e  (e<d , (_                              , e∈CGB)) | in₁ c~e | in₂ e<c = (in₂ (_ , (in₂ refl , (e<c , ~-sym c~e))) , e∈CGB)
  lemma e  (e<d , (in₁ e∈A                        , e∈CGB)) | in₂ c≁e = ((in₁ (in₁ (c≁e , e∈A))) , e∈CGB)
  lemma e  (e<d , (in₂ (a , (a∈A ,  (e<a , e~a))) , e∈CGB)) | in₂ c≁e = (in₂ (a , (in₁ ((λ c~a → c≁e (~-trans c~a (~-sym e~a))) , a∈A) , (e<a , e~a))) , e∈CGB)

  lemma′ : ((A′ ∪ JointSessionPast′) ∩ CanGoBack) ⊆ ((A ∪ JointSessionPast) ∩ CanGoBack)
  lemma′ e  (in₁ (in₁ (c≁e , e∈A)) , e∈CGB) = ((in₁ e∈A) , e∈CGB)
  lemma′ ._ (in₁ (in₂ refl) , c∈CGB) = ((in₂ (d , (d∈A , (c<d , c~d)))) , c∈CGB)
  lemma′ e (in₂ (a , (in₁ (c≁a , a∈A) , e≲a)) , e∈CGB) = (in₂ (a , (a∈A , e≲a)) , e∈CGB)
  lemma′ e (in₂ (._ , (in₂ refl , e≲c)) , e∈CGB) = ((in₂ (d , (d∈A , ≲-trans e≲c (c<d , c~d)))) , e∈CGB)

  lemma″ : ((A′ ∪ JointSessionPast′) ∩ CanGoBack) ⊆ (Past(d))
  lemma″ e  (in₁ (in₁ (c≁e , e∈A)) , e∈CGB) = (d-max e (e∈A , e∈CGB) , (λ e≡d → c≁e (~-trans c~d (≡-impl-~ (sym e≡d)))))
  lemma″ ._ (in₁ (in₂ refl) , c∈CGB) = c<d
  lemma″ e (in₂ (a , (in₁ (c≁a , a∈A) , e≲a)) , e∈CGB) = <-trans-≤ (≲-impl-< e≲a) (d-max a (a∈A , (e , e≲a)))
  lemma″ e (in₂ (._ , (in₂ refl , (e<c , e~c))) , e∈CGB) = <-trans e<c c<d

  d<ds : (ds ∈ All(Past(d)))
  d<ds = All-resp-⊆ lemma″ ds ds∈JSP′∩CGB

  d∷ds-max : ∀ es → es ∈ (Decreasing ∩ All ((A ∪ JointSessionPast) ∩ CanGoBack)) → (es ≤* (d ∷ ds))
  d∷ds-max (e ∷ es) ((es<e , es↓) , ((e∈A∪JSP , e∈CGB) , es∈A∪JSP∩CGB)) = (e≤d , es≤ds) where

    lemma‴ : ∀ f → (f ∈ ((A ∪ JointSessionPast) ∩ CanGoBack)) → (f ≤ d)
    lemma‴ f (in₁ f∈A , f∈CGB) = d-max f (f∈A , f∈CGB)
    lemma‴ f (in₂ (a , (a∈A , ((f≤a , f≠a) , f~a))) , f∈CGB) = ≤-trans f≤a (d-max a (a∈A , (f , ((f≤a , f≠a) , f~a))))

    e≤d : (e ≤ d)
    e≤d = lemma‴ e (e∈A∪JSP , e∈CGB)

    es<d : es ∈ All(Past(d))
    es<d = All-resp-⊆ (λ f f<e → <-trans-≤ f<e e≤d) es es<e

    es≤ds : es ≤* ds
    es≤ds = ds-max es (es↓ , All-resp-⊆ lemma es (All-resp-∩ es (es<d , es∈A∪JSP∩CGB)))

fwd? : ∀ {D} {H : NavigationHistory(D)} {δ} (ds : D ^ δ) →
  (ds ∈ FwdTarget*(H)) →
  (H traverses-by (+ve δ) to (H traverses-to ds))
fwd? {D} {H} {δ = zero} nil nil∈FT = back nil tt (BT-nil {H = H})
fwd? {D} {H} {δ = succ δ} ds ds∈FT = fwd ds ds∈FT

FT-hd : ∀ {D} {H : NavigationHistory(D)} {n} d (ds : D ^ n) →
  ((d ∷ ds) ∈ FwdTarget*(H)) →
  (d ∈ FwdTarget(H))
FT-hd {D} {H} d ds (((d<ds , ds↑) , (d∈JSF , ds∈JSF)) , d∷ds-min) = (d∈JSF , d-min) where

  open NavigationHistory H

  d-min : ∀ e → (e ∈ JointSessionFuture) → (d ≤ e)
  d-min e e∈JSF with ≤-total d e
  d-min e e∈JSF | in₁ d≤e = d≤e
  d-min e e∈JSF | in₂ e<d with d∷ds-min (e ∷ ds) (((All-resp-⊆ (λ f → <-trans e<d) ds d<ds) , ds↑) , (e∈JSF , ds∈JSF))
  d-min e e∈JSF | in₂ e<d | (d≤e , ds≤ds) = d≤e

FT-tl : ∀ {D} {H : NavigationHistory(D)} {n} d (ds : D ^ n) →
  ((d ∷ ds) ∈ FwdTarget*(H)) →
  (ds ∈ FwdTarget*(H traverse-to d))
FT-tl {D} {H} d ds (((d<ds , ds↑) , ((a , (a∈A , (a<d , a~d))) , ds∈JSF)) , d∷ds-min) = ((ds↑ , ds∈JSF′) , ds-min) where

  H′ = (H traverse-to d)

  open NavigationHistory H
  open NavigationHistory H′ using () renaming (JointSessionFuture to JointSessionFuture′)

  lemma : ((Future(d) ∩ JointSessionFuture) ⊆ JointSessionFuture′)
  lemma e (d<e , (b , (b∈A , (b<e , b~e)))) with d ~? b
  lemma e (d<e , (b , (b∈A , (b<e , b~e)))) | in₁ d~b = (d , (in₂ refl , (d<e , (~-trans d~b b~e))))
  lemma e (d<e , (b , (b∈A , (b<e , b~e)))) | in₂ d≁b = (b , (in₁ (d≁b , b∈A) , (b<e , b~e)))

  lemma′ : (JointSessionFuture′ ⊆ Future(d))
  lemma′ e (b  , (in₁ (d≁b , b∈A) , (b<e , b~e))) with ≤-total e d
  lemma′ e (b  , (in₁ (d≁b , b∈A) , (b<e , b~e))) | in₁ e≤d with d∷ds-min (e ∷ ds) (((All-resp-⊆ (λ f → ≤-trans-< e≤d) ds d<ds) , ds↑) , ((b , (b∈A , (b<e , b~e))) , ds∈JSF))
  lemma′ e (b  , (in₁ (d≁b , b∈A) , (b<e , b~e))) | in₁ e≤d | (d≤e , ds≤ds) = contradiction (d≁b (~-trans (≡-impl-~ (≤-asym d≤e e≤d)) (~-sym b~e)))
  lemma′ e (b  , (in₁ (d≁b , b∈A) , (b<e , b~e))) | in₂ d<e = d<e
  lemma′ e (.d , (in₂ refl        , (d<e , d~e))) = d<e

  lemma″ : (JointSessionFuture′ ⊆ JointSessionFuture)
  lemma″ e (b  , (in₁ (d≁b , b∈A) , (b<e , b~e))) = (b , (b∈A , (b<e , b~e)))
  lemma″ e (.d , (in₂ refl        , (d<e , d~e))) = a , (a∈A , (<-trans a<d d<e , ~-trans a~d d~e))

  ds∈JSF′ : (ds ∈ All(JointSessionFuture′))
  ds∈JSF′ = All-resp-⊆ lemma ds (All-resp-∩ ds (d<ds , ds∈JSF))

  ds-min : ∀ es → (es ∈ (Increasing ∩ All(JointSessionFuture′))) → (ds ≤* es)
  ds-min es (es↑ , es∈JSF′) with d∷ds-min (d ∷ es) ((d<es , es↑) , ((a , (a∈A , (a<d , a~d))) , es∈JSF)) where

    d<es : es ∈ All(Future(d))
    d<es = All-resp-⊆ lemma′ es es∈JSF′

    es∈JSF : es ∈ All(JointSessionFuture)
    es∈JSF = All-resp-⊆ lemma″ es es∈JSF′

  ds-min es (es↑ , es∈JSF′) | (d≤d , ds≤es) = ds≤es

FT-nil :  ∀ {D} {H : NavigationHistory(D)} →
  (nil ∈ FwdTarget*(H))
FT-nil = ((tt , tt) , λ { nil (tt , tt) → tt })

FT-cons : ∀ {D} {H : NavigationHistory(D)} {n} d (ds : D ^ n) →
  (d ∈ FwdTarget(H)) →
  (ds ∈ FwdTarget*(H traverse-to d)) →
  ((d ∷ ds) ∈ FwdTarget*(H))
FT-cons {D} {H} d ds ((a , (a∈A , (a<d , a~d))) , d-min) ((ds↑ , ds∈JSF′) , ds-min) = (((d<ds , ds↑) , ((a , (a∈A , (a<d , a~d))) , ds∈JSF)) , d∷ds-min) where

  H′ = (H traverse-to d)

  open NavigationHistory H
  open NavigationHistory H′ using () renaming (JointSessionFuture to JointSessionFuture′)

  lemma : ((Future(d) ∩ JointSessionFuture) ⊆ JointSessionFuture′)
  lemma e (d<e , (b , (b∈A , (b<e , b~e)))) with d ~? b
  lemma e (d<e , (b , (b∈A , (b<e , b~e)))) | in₁ d~b = (d , (in₂ refl , (d<e , (~-trans d~b b~e))))
  lemma e (d<e , (b , (b∈A , (b<e , b~e)))) | in₂ d≁b = (b , (in₁ (d≁b , b∈A) , (b<e , b~e)))

  lemma′ : (JointSessionFuture′ ⊆ Future(d))
  lemma′ e (b  , (in₁ (d≁b , b∈A) , (b<e , b~e))) with ≤-total e d
  lemma′ e (b  , (in₁ (d≁b , b∈A) , (b<e , b~e))) | in₁ e≤d with d-min e (b , (b∈A , (b<e , b~e)))
  lemma′ e (b  , (in₁ (d≁b , b∈A) , (b<e , b~e))) | in₁ e≤d | d≤e = contradiction (d≁b (~-trans (≡-impl-~ (≤-asym d≤e e≤d)) (~-sym b~e)))
  lemma′ e (b  , (in₁ (d≁b , b∈A) , (b<e , b~e))) | in₂ d<e = d<e
  lemma′ e (.d , (in₂ refl        , (d<e , d~e))) = d<e

  lemma″ : (JointSessionFuture′ ⊆ JointSessionFuture)
  lemma″ e (b  , (in₁ (d≁b , b∈A) , (b<e , b~e))) = (b , (b∈A , (b<e , b~e)))
  lemma″ e (.d , (in₂ refl        , (d<e , d~e))) = (a , (a∈A , (<-trans a<d d<e , ~-trans a~d d~e)))

  d<ds : ds ∈ All(Future(d))
  d<ds = All-resp-⊆ lemma′ ds ds∈JSF′

  ds∈JSF : ds ∈ All(JointSessionFuture)
  ds∈JSF = All-resp-⊆ lemma″ ds ds∈JSF′

  d∷ds-min : ∀ es → (es ∈ (Increasing ∩ All(JointSessionFuture))) → ((d ∷ ds) ≤* es)
  d∷ds-min (e ∷ es) ((e<es , es↑) , (e∈JSF , es∈JSF)) = (d≤e , ds≤es) where

    d≤e : (d ≤ e)
    d≤e = d-min e e∈JSF

    d<es : es ∈ All(Future(d))
    d<es = All-resp-⊆ (λ f → ≤-trans-< d≤e) es e<es

    es∈JSF′ : (es ∈ All(JointSessionFuture′))
    es∈JSF′ = All-resp-⊆ lemma es (All-resp-∩ es (d<es , es∈JSF))

    ds≤es : (ds ≤* es)
    ds≤es = ds-min es (es↑ , es∈JSF′)

from-to : ∀ {D} {H : NavigationHistory(D)} d e d∈CGB →
  (WellFormed(H)) →
  (d ∈ BackTarget(H)) →
  (e ∈ FwdTarget(H traverse-from d ∵ d∈CGB)) →
  (H ≣ ((H traverse-from d ∵ d∈CGB) traverse-to e))
from-to {D} {H} d e d∈CGB H∈WF ((d∈A , _) , d-max) e∈FT′ with lemma e∈FT′ where

  H′ = (H traverse-from d ∵ d∈CGB)

  open NavigationHistory H
  open NavigationHistory H′ using () renaming (JointSessionFuture to JointSessionFuture′ ; FwdTarget to FwdTarget′)

  lemma : (e ∈ FwdTarget′) → (d ≡ e)
  lemma (e∈JSP′ , e-min) with max(SessionPast(d)) ∵ d∈CGB | ≤-total d e
  lemma (e∈JSP′ , e-min) | (c , ((c<d , c~d) , c-max)) | in₁ d≤e = ≤-asym d≤e (e-min d (c , (in₂ refl , (c<d , c~d))))
  lemma ((a  , (in₁ (c≁a , a∈A) , (a<e , a~e))) , e-min) | c , ((c<d , c~d) , c-max) | in₂ e<d = contradiction (<-impl-≱ e<d (H∈WF (a<e , a~e) (c<d , c~d) a∈A d∈A))
  lemma ((.c , (in₂ refl , (c<e , c~e))) , e-min) | c , ((c<d , c~d) , c-max) | in₂ e<d = contradiction (<-impl-≱ c<e (c-max e (e<d , ~-trans (~-sym c~e) c~d)))

from-to {D} {H} d .d d∈CGB H∈WF ((d∈A , _) , d-max) e∈FT′ | refl = H=H″ where

  H′ = (H traverse-from d ∵ d∈CGB)
  H″ = (H′ traverse-to d)

  open NavigationHistory H
  open NavigationHistory H″ using () renaming (A to A″)

  A⊆A″ : (A ⊆ A″)
  A⊆A″ f f∈A with d ~? f
  A⊆A″ f f∈A | in₁ d~f with active-~-impl-≡ d∈A f∈A d~f
  A⊆A″ .d  _ | in₁ d~f | refl = in₂ refl
  A⊆A″ f f∈A | in₂ d≁f with max(SessionPast(d)) ∵ d∈CGB
  A⊆A″ f f∈A | in₂ d≁f | (c , ((c<d , c~d) , c-max)) = in₁ (d≁f , (in₁ ((λ c~f → d≁f (~-trans (~-sym c~d) c~f)) , f∈A)))

  A″⊆A : (A″ ⊆ A)
  A″⊆A f (in₁ (d≁f , in₁ (c≁f , f∈A))) = f∈A
  A″⊆A ._ (in₁ (d≁c , in₂ refl)) with max(SessionPast(d)) ∵ d∈CGB
  A″⊆A ._ (in₁ (d≁c , in₂ refl)) | (c , ((c<d , c~d) , c-max)) = contradiction (d≁c (~-sym c~d))
  A″⊆A ._ (in₂ refl) = d∈A

  H=H″ : (H ≣ H″)
  H=H″ = NH-CONG H H″ A⊆A″ A″⊆A REFL REFL REFL

to-from : ∀ {D} {H : NavigationHistory(D)} d e e∈CGB →
  (WellFormed(H)) →
  (d ∈ FwdTarget(H)) →
  (e ∈ BackTarget(H traverse-to d)) →
  (H ≣ ((H traverse-to d) traverse-from e ∵ e∈CGB))
to-from {D} {H} d e e∈CGB H∈WF ((a , (a∈A , (a<d , a~d))) , d-min) e∈BT′ with lemma e∈BT′ | max(SessionPast(e)) ∵ e∈CGB where

  H′ = (H traverse-to d)

  open NavigationHistory H
  open NavigationHistory H′ using () renaming (BackTarget to BackTarget′)

  lemma : (e ∈ BackTarget′) → (d ≡ e)
  lemma ((in₁ (d≁e , e∈A) , (b , (b<e , b~e))) , e-max) = ≤-asym d≤e e≤d where

    d≤e : (d ≤ e)
    d≤e = e-max d (in₂ refl , (a , (a<d , a~d)))

    e≤d : (e ≤ d)
    e≤d = H∈WF (a<d , a~d) (b<e , b~e) a∈A e∈A

  lemma ((in₂ d≡e , _) , _) = d≡e

to-from {D} {H} d .d d∈CGB H∈WF ((a , (a∈A , (a<d , a~d))) , d-min) (_ , d-max) | refl | (c , ((c<d , c~d) , c-max)) with ≤-asym a≤c c≤a where

  open NavigationHistory H

  c≤a : (c ≤ a)
  c≤a with ≤-total c a
  c≤a | in₁ c≤a = c≤a
  c≤a | in₂ a<c = contradiction (<-impl-≱ (<-trans-≤ c<d (d-min c (a , (a∈A , (a<c , (~-trans a~d (~-sym c~d))))))) ≤-refl)

  a≤c : (a ≤ c)
  a≤c = c-max a (a<d , a~d)

to-from {D} {H} d .d d∈CGB H∈WF ((a , (a∈A , (a<d , a~d))) , d-min) (_ , d-max) | refl | (.a , ((_ , _) , a-max)) | refl = H=H″ where

  H′ = (H traverse-to d)
  H″ = (H′ traverse-to a)

  open NavigationHistory H
  open NavigationHistory H″ using () renaming (A to A″)

  A⊆A″ : (A ⊆ A″)
  A⊆A″ f f∈A with a ~? f
  A⊆A″ f f∈A | in₁ a~f = in₂ (active-~-impl-≡ a∈A f∈A (~-trans (~-trans a~d (~-sym a~d)) a~f))
  A⊆A″ f f∈A | in₂ a≁f = in₁ (a≁f , (in₁ ((λ d~f → a≁f (~-trans a~d d~f)) , f∈A)))

  A″⊆A : (A″ ⊆ A)
  A″⊆A f  (in₁ (_ , in₁ (_ , f∈A))) = f∈A
  A″⊆A .d (in₁ (a≁d , in₂ refl)) = contradiction (a≁d a~d)
  A″⊆A .a (in₂ refl) = a∈A

  H=H″ : (H ≣ H″)
  H=H″ = NH-CONG H H″ A⊆A″ A″⊆A REFL REFL REFL

fwd-WF : ∀ {D} (H : NavigationHistory(D)) e →
  WellFormed(H) →
  (e ∈ FwdTarget(H)) →
  WellFormed(H traverse-to e)
fwd-WF H e H∈WF ((f , (f∈A , f≲e)) , e-min) a≲b c≲d (in₁ (e≁a , a∈A)) (in₁ (e≁d , d∈A)) = H∈WF a≲b c≲d a∈A d∈A
fwd-WF H e H∈WF ((f , (f∈A , f≲e)) , e-min) a≲b c≲e (in₁ (e≁a , a∈A)) (in₂ refl)        = e-min _ (_ , (a∈A , a≲b))
fwd-WF H e H∈WF ((f , (f∈A , f≲e)) , e-min) e≲b c≲d (in₂ refl)        (in₁ (e≁d , d∈A)) = H∈WF (≲-trans f≲e e≲b) c≲d f∈A d∈A where open NavigationHistory H
fwd-WF H e H∈WF ((f , (f∈A , f≲e)) , e-min) e≲b c≲e (in₂ refl)        (in₂ refl)        = e-min _ (f , (f∈A , ≲-trans f≲e e≲b)) where open NavigationHistory H

back-WF : ∀ {D} (H : NavigationHistory(D)) e e∈CGB →
  WellFormed(H) →
  (e ∈ BackTarget(H)) →
  WellFormed(H traverse-from e ∵ e∈CGB)
back-WF H e e∈CGB H∈WF ((e∈A , _) , e-max)         (a<b , a~b) c≲d a∈A′              d∈A′              with max(SessionPast(e)) ∵ e∈CGB where open NavigationHistory H
back-WF H e e∈CGB H∈WF ((e∈A , _) , e-max)         (a<b , a~b) c≲d (in₁ (f≁a , a∈A)) (in₁ (f≁d , d∈A)) | (f , ((f<e , f~e) , f-max)) = H∈WF (a<b , a~b) c≲d a∈A d∈A
back-WF H e e∈CGB H∈WF ((e∈A , _) , e-max)         (a<b , a~b) c≲f (in₁ (f≁a , a∈A)) (in₂ refl)        | (f , ((f<e , f~e) , f-max)) = ≤-trans (<-impl-≤ f<e) (H∈WF (a<b , a~b) (f<e , f~e) a∈A e∈A) where open NavigationHistory H
back-WF H e e∈CGB H∈WF ((e∈A , _) , e-max) {b = b} (f<b , f~b) c≲d (in₂ refl)        (in₁ (f≁d , d∈A)) | (f , ((f<e , f~e) , f-max)) with ≤-total b e | ≤-total e b where open NavigationHistory H
back-WF H e e∈CGB H∈WF ((e∈A , _) , e-max)         (f<b , f~b) c≲d (in₂ refl)        (in₁ (f≁d , d∈A)) | (f , ((f<e , f~e) , f-max)) | in₁ b≤e | in₁ e≤b with ≤-asym b≤e e≤b where open NavigationHistory H
back-WF H e e∈CGB H∈WF ((e∈A , _) , e-max)         (f<b , f~b) c≲d (in₂ refl)        (in₁ (f≁d , d∈A)) | (f , ((f<e , f~e) , f-max)) | in₁ b≤e | in₁ e≤b | refl = e-max _ (d∈A , (_ , c≲d))
back-WF H e e∈CGB H∈WF ((e∈A , _) , e-max)         (f<b , f~b) c≲d (in₂ refl)        (in₁ (f≁d , d∈A)) | (f , ((f<e , f~e) , f-max)) | in₁ b≤e | in₂ b<e = contradiction (<-impl-≱ f<b (f-max _ (b<e , ~-trans (~-sym f~b) f~e))) where open NavigationHistory H
back-WF H e e∈CGB H∈WF ((e∈A , _) , e-max)         (f<b , f~b) c≲d (in₂ refl)        (in₁ (f≁d , d∈A)) | (f , ((f<e , f~e) , f-max)) | in₂ e<b | _ = H∈WF (e<b , ~-trans (~-sym f~e) f~b) c≲d e∈A d∈A where open NavigationHistory H
back-WF H e e∈CGB H∈WF ((e∈A , _) , e-max)         (f<b , f~b) c≲f (in₂ refl)        (in₂ refl)        | (f , ((f<e , f~e) , f-max)) = <-impl-≤ f<b where open NavigationHistory H


{-# OPTIONS --rewriting #-}
module _ where

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

data D (A : Set) : Set₁ where
  c₁ : D A
  c₂ : Set → D A

f : {A : Set} → D A → Set
f c₁ = Bool
f (c₂ X) = X

postulate
  rew : (A : Set) → c₁ {A} ≡ c₂ A

-- This rewrite rule is rejected because the A on the lhs of the rule
-- only appears in a parameter position, but parameters are erased.
-- Reconstructing the parameter would only be possible if we had
-- access to the type during reduction, but we don't.
{-# REWRITE rew #-}

boom : f {Bool} c₁ ≡ Bool
boom = refl


postulate
  T : Set → Set
  _>>=_ : ∀ {A B} → T A → (A → T B) → T B

argh : ∀ {A} → T A → T A
argh ta = do
  f x ← ta
  {!!}


{-# OPTIONS --safe #-}

module Definition.Typed.Consequences.Equality where

open import Definition.Untyped
open import Definition.Typed
open import Definition.Typed.Properties
open import Definition.Typed.EqRelInstance
open import Definition.LogicalRelation
open import Definition.LogicalRelation.Properties.Escape
open import Definition.LogicalRelation.Irrelevance
open import Definition.LogicalRelation.ShapeView
open import Definition.LogicalRelation.Fundamental.Reducibility
open import Definition.Typed.Consequences.Injectivity

open import Tools.Product
import Tools.PropositionalEquality as PE

{-

-- conversion is cumulative

typeCumul′ : ∀ {A rA lA lA' Γ} → lA ≤∞ lA' →  Γ ⊩⟨ ∞ ⟩ A ^ [ rA , lA ] → Γ ⊩⟨ ∞ ⟩ A ^ [ rA , lA' ]
typeCumul′ (≡is≤∞ PE.refl) [A] = [A]
typeCumul′ (<∞is≤∞ emb<) (Uᵣ (Uᵣ r l′ l<₁ eq d)) = emb ∞< (Uᵣ (Uᵣ r ⁰ emb< PE.refl {!!}))
typeCumul′ (<∞is≤∞ ∞<) (Uᵣ (Uᵣ r l′ l<₁ eq d)) = Uᵣ (Uᵣ r ¹ ∞< PE.refl {!!})
typeCumul′ (<∞is≤∞ emb<) (ℕᵣ [[ ⊢A , ⊢B , D ]]) = emb ∞< (emb emb< {!ℕᵣ ?!})
typeCumul′ (<∞is≤∞ l<) (Emptyᵣ x) = {!!}
typeCumul′ (<∞is≤∞ l<) (ne x) = {!!}
typeCumul′ (<∞is≤∞ l<) (Πᵣ x) = {!!}
typeCumul′ (<∞is≤∞ l<) (∃ᵣ x) = {!!}
typeCumul′ (<∞is≤∞ l<) (emb l<₁ [A]) = {!!}

convCumul′ : ∀ {A B rA lA lA' Γ} → (l< : lA ≤∞ lA') → ([A] : Γ ⊩⟨ ∞ ⟩ A ^ [ rA , lA ])
             → Γ ⊩⟨ ∞ ⟩ A ≡ B ^ [ rA , lA ] / [A] → Γ ⊩⟨ ∞ ⟩ A ≡ B ^ [ rA , lA' ] / typeCumul′ l< [A]
convCumul′ (<∞is≤∞ l<) [A] [A≡B] = {!!}
convCumul′ (≡is≤∞ PE.refl) [A] [A≡B] = [A≡B]

convCumul : ∀ {A B rA lA lA' Γ} → lA ≤∞ lA' → Γ ⊢ A ≡ B ^ [ rA , lA ] → Γ ⊢ A ≡ B ^ [ rA , lA' ]
convCumul {A} {B} {rA} {lA} {lA'} {Γ} (<∞is≤∞ l<) A≡B =
  let X = reducibleEq A≡B
      [A] = proj₁ X
      [B] = proj₁ (proj₂ X)
      [A≡B] = proj₂ (proj₂ X)
      [A]' : Γ ⊩⟨ ∞ ⟩ A ^ [ rA , lA' ]
      [A]' = emb l< {!!} -- [A]
  in {!escapeEq [A]' [A≡B]!}
-- convCumul (<∞is≤∞ ∞<) A≡B =
--   let X = reducibleEq A≡B
--       [A] = proj₁ X
--       [B] = proj₁ (proj₂ X)
--       [A≡B] = proj₂ (proj₂ X)
--   in {!!}
convCumul (≡is≤∞ PE.refl) A≡B = A≡B
-}

U≡A′ : ∀ {A rU Γ l lU nlU } ([U] : Γ ⊩⟨ l ⟩U Univ rU lU ^ nlU)
    → Γ ⊩⟨ l ⟩ Univ rU lU ≡ A ^ [ ! , nlU ] / (U-intr [U])
    → Γ ⊢ A ⇒* Univ rU lU ^ [ ! , nlU ]
U≡A′ (noemb (Uᵣ r l′ l< eq d)) [U≡A] =
 let r≡r , l≡l  = Uinjectivity (subset* (red d))
 in PE.subst (λ r → _ ⊢ _ ⇒* Univ r _ ^ [ ! , _ ]) (PE.sym r≡r)
         (PE.subst (λ l → _ ⊢ _ ⇒* Univ _ l ^ [ ! , _ ]) (PE.sym l≡l) [U≡A])
U≡A′ (emb emb< [U]) [U≡A] = U≡A′ [U] [U≡A]
U≡A′ (emb ∞< [U]) [U≡A] = U≡A′ [U] [U≡A]

-- If A is judgmentally equal to U, then A reduces to U.
U≡A : ∀ {A rU Γ lU nlU }
    → Γ ⊢ Univ rU lU ≡ A ^ [ ! , nlU ]
    → Γ ⊢ A ⇒* Univ rU lU ^ [ ! , nlU ]
U≡A {A} U≡A =
  let X = reducibleEq U≡A
      [U] = proj₁ X
      [A] = proj₁ (proj₂ X)
      [U≡A] = proj₂ (proj₂ X)
  in U≡A′ (U-elim [U]) (irrelevanceEq [U] (U-intr (U-elim [U])) [U≡A])

-- If A is judgmentally equal to U, then A reduces to U.
U≡A-whnf : ∀ {A rU Γ lU nlU }
    → Γ ⊢ Univ rU lU ≡ A ^ [ ! , nlU ]
    → Whnf A
    → A PE.≡ Univ rU lU
U≡A-whnf {A} X whnfA = whnfRed* (U≡A X) whnfA

ℕ≡A′ : ∀ {A Γ l} ([ℕ] : Γ ⊩⟨ l ⟩ℕ ℕ)
    → Γ ⊩⟨ l ⟩ ℕ ≡ A ^ [ ! , ι ⁰ ] / (ℕ-intr [ℕ])
    → Whnf A
    → A PE.≡ ℕ
ℕ≡A′ (noemb x) [ℕ≡A] whnfA = whnfRed* [ℕ≡A] whnfA
ℕ≡A′ (emb emb< [ℕ]) [ℕ≡A] whnfA = ℕ≡A′ [ℕ] [ℕ≡A] whnfA
ℕ≡A′ (emb ∞< [ℕ]) [ℕ≡A] whnfA = ℕ≡A′ [ℕ] [ℕ≡A] whnfA

-- If A in WHNF is judgmentally equal to ℕ, then A is propsitionally equal to ℕ.
ℕ≡A : ∀ {A Γ}
    → Γ ⊢ ℕ ≡ A ^ [ ! , ι ⁰ ]
    → Whnf A
    → A PE.≡ ℕ
ℕ≡A {A} ℕ≡A whnfA =
  let X = reducibleEq ℕ≡A
      [ℕ] = proj₁ X
      [A] = proj₁ (proj₂ X)
      [ℕ≡A] = proj₂ (proj₂ X)
  in ℕ≡A′ (ℕ-elim [ℕ]) (irrelevanceEq [ℕ] (ℕ-intr (ℕ-elim [ℕ])) [ℕ≡A]) whnfA

-- If A in WHNF is judgmentally equal to Empty, then A is propositionally equal to Empty.
Empty≡A′ : ∀ {A Γ l ll} ([Empty] : Γ ⊩⟨ l ⟩Empty Empty ll ^ ll)
    → Γ ⊩⟨ l ⟩ Empty ll ≡ A ^ [ % , ι ll ] / (Empty-intr [Empty])
    → Whnf A
    → A PE.≡ Empty ll
Empty≡A′ (noemb x) [Empty≡A] whnfA = whnfRed* [Empty≡A] whnfA
Empty≡A′ (emb emb< [Empty]) [Empty≡A] whnfA = Empty≡A′ [Empty] [Empty≡A] whnfA
Empty≡A′ (emb ∞< [Empty]) [Empty≡A] whnfA = Empty≡A′ [Empty] [Empty≡A] whnfA

Empty≡A : ∀ {A Γ l}
    → Γ ⊢ Empty l ≡ A ^ [ % , ι l ]
    → Whnf A
    → A PE.≡ Empty l
Empty≡A {A} Empty≡A whnfA =
  let X = reducibleEq Empty≡A
      [Empty] = proj₁ X
      [A] = proj₁ (proj₂ X)
      [Empty≡A] = proj₂ (proj₂ X)
  in Empty≡A′ (Empty-elim [Empty]) (irrelevanceEq [Empty] (Empty-intr (Empty-elim [Empty])) [Empty≡A]) whnfA

ne≡A′ : ∀ {A K r Γ l ll }
     → ([K] : Γ ⊩⟨ l ⟩ne K ^[ r , ll ] )
     → Γ ⊩⟨ l ⟩ K ≡ A ^ [ r , ι ll ] / (ne-intr [K])
     → Whnf A
     → ∃ λ M → Neutral M × A PE.≡ M
ne≡A′ (noemb [K]) (ne₌ M D′ neM K≡M) whnfA =
  M , neM , (whnfRed* (red D′) whnfA)
ne≡A′ (emb emb< [K]) [K≡A] whnfA = ne≡A′ [K] [K≡A] whnfA
ne≡A′ (emb ∞< [K]) [K≡A] whnfA = ne≡A′ [K] [K≡A] whnfA

-- If A in WHNF is judgmentally equal to K, then there exists a M such that
-- A is propsitionally equal to M.
ne≡A : ∀ {A K r l Γ}
    → Neutral K
    → Γ ⊢ K ≡ A ^ [ r , ι l ]
    → Whnf A
    → ∃ λ M → Neutral M × A PE.≡ M
ne≡A {A} neK ne≡A whnfA =
  let X = reducibleEq ne≡A
      [ne] = proj₁ X
      [A] = proj₁ (proj₂ X)
      [ne≡A] = proj₂ (proj₂ X)
  in ne≡A′ (ne-elim neK [ne])
        (irrelevanceEq [ne] (ne-intr (ne-elim neK [ne])) [ne≡A]) whnfA

Π≡A′ : ∀ {A F G rF lF lG rΠ lΠ Γ l} ([Π] : Γ ⊩⟨ l ⟩Π Π F ^ rF ° lF ▹ G ° lG ° lΠ ^[ rΠ , lΠ ] )
    → Γ ⊩⟨ l ⟩ Π F ^ rF ° lF ▹ G ° lG ° lΠ ≡ A ^ [ rΠ ,  ι lΠ ] / (Π-intr [Π])
    → Whnf A
    → ∃₂ λ H E → A PE.≡ Π H ^ rF ° lF ▹ E ° lG ° lΠ
Π≡A′ (noemb (Πᵣ rF′ lF′ lG′ lF≤ lG≤  F G D ⊢F ⊢G A≡A [F] [G] G-ext)) (Π₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) whnfA =
    let _ , rF≡rF′ , lF≡lF′ , _ , lG≡lG′ , _ = Π-PE-injectivity (whnfRed* (red D) Πₙ)
        X = whnfRed* D′ whnfA
    in F′ , G′ ,
       PE.subst (λ r → _ PE.≡ Π _ ^ r ° _ ▹ _ ° _ ° _) (PE.sym rF≡rF′)
         (PE.subst (λ l → _ PE.≡ Π _ ^ _ ° l ▹ _ ° _ ° _) (PE.sym lF≡lF′)
           (PE.subst (λ l → _ PE.≡ Π _ ^ _ ° _ ▹ _ ° l ° _) (PE.sym lG≡lG′) X))
Π≡A′ (emb emb< [Π]) [Π≡A] whnfA = Π≡A′ [Π] [Π≡A] whnfA
Π≡A′ (emb ∞< [Π]) [Π≡A] whnfA = Π≡A′ [Π] [Π≡A] whnfA

-- If A is judgmentally equal to Π F ▹ G, then there exists H and E such that
-- A is propositionally equal to Π H ▹ E.
Π≡A : ∀ {A F G rF lF lG rΠ lΠ Γ}
    → Γ ⊢ Π F ^ rF ° lF ▹ G ° lG ° lΠ ≡ A ^ [ rΠ ,  ι lΠ ]
    → Whnf A
    → ∃₂ λ H E → A PE.≡ Π H ^ rF ° lF ▹ E ° lG ° lΠ
Π≡A {A} Π≡A whnfA  =
  let X = reducibleEq Π≡A
      [Π] = proj₁ X
      [A] = proj₁ (proj₂ X)
      [Π≡A] = proj₂ (proj₂ X)
  in Π≡A′ (Π-elim [Π]) (irrelevanceEq [Π] (Π-intr (Π-elim [Π])) [Π≡A]) whnfA


module Lang.Instance where

import      Lvl
open import Type

private variable ℓ : Lvl.Level
private variable T X Y Z : Type{ℓ}

-- Infers/resolves/(searches for) an instance/proof of the specified type/statement
resolve : (T : Type{ℓ}) →  ⦃ _ : T ⦄ → T
resolve (_) ⦃ x ⦄ = x

-- Infers/resolves/(searches for) an instance/proof of an inferred type/statement
infer : ⦃ _ : T ⦄ → T
infer ⦃ x ⦄ = x

inst-fn : (X → Y) → (⦃ inst : X ⦄ → Y)
inst-fn P ⦃ x ⦄ = P(x)

inst-fn₂ : (X → Y → Z) → (⦃ inst₁ : X ⦄ → ⦃ inst₂ : Y ⦄ → Z)
inst-fn₂ P ⦃ x ⦄ ⦃ y ⦄ = P(x)(y)

inst-fnᵢ : ({_ : X} → Y → Z) → ({_ : X} → ⦃ _ : Y ⦄ → Z)
inst-fnᵢ P {x} ⦃ y ⦄ = P{x}(y)

impl-to-expl : ({ _ : X} → Y) → (X → Y)
impl-to-expl f(x) = f{x}

expl-to-impl : (X → Y) → ({ _ : X} → Y)
expl-to-impl f{x} = f(x)


A : Set₁
A = Set

{-# POLARITY A #-}


-- Andreas, 2020-03-18, issue 4518, reported by strangeglyph

-- Better error message when parsing of LHS fails

open import Agda.Builtin.Nat using (Nat) -- forgot to import constructors

postulate
  foo : Nat

test : Set₁
test with foo
... | zero  = Set
... | suc n = Set

-- ERROR:
-- Could not parse the left-hand side test | suc n
-- NEW INFORMATION:
-- Problematic expression: (suc n)


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

module index where

-- An organised list of modules:
import Pi.Everything

-- An exhaustive list of all modules:


{- 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
-}

-- This module contains properties that are only about the behavior of the handlers, nothing to do
-- with system state

open import Optics.All
open import LibraBFT.Prelude
open import LibraBFT.Base.ByteString
open import LibraBFT.Base.Types
open import LibraBFT.Hash
open import LibraBFT.Impl.Base.Types
open import LibraBFT.Impl.Consensus.Types
open import LibraBFT.Impl.Util.Util

module LibraBFT.Impl.Consensus.ChainedBFT.EventProcessor.Properties
  (hash    : BitString → Hash)
  (hash-cr : ∀{x y} → hash x ≡ hash y → Collision hash x y ⊎ x ≡ y)
  where

  open import LibraBFT.Impl.Consensus.ChainedBFT.EventProcessor hash hash-cr

  -- The quorum certificates sent in SyncInfo with votes are those from the peer state
  procPMCerts≡ : ∀ {ts pm pre vm αs}
               → (SendVote vm αs) ∈ LBFT-outs (processProposalMsg ts pm) pre
               → vm ^∙ vmSyncInfo ≡ mkSyncInfo (₋epHighestQC pre) (₋epHighestCommitQC pre)
  procPMCerts≡ (there x)   = ⊥-elim (¬Any[] x)  -- processProposalMsg sends only one vote
  procPMCerts≡ (here refl) = refl


-- 2014-09-19
-- Reported by Mateusz Kowalczyk.

good : Set₁
good = let -- F : _  -- worked if you added the type signature
           F X = X
       in F Set

-- Now works without the type signature.


open import Nat
open import Prelude
open import contexts
open import core
open import type-assignment-unicity

module canonical-indeterminate-forms where

  -- this type gives somewhat nicer syntax for the output of the canonical
  -- forms lemma for indeterminates at base type
  data cif-base : (Δ : hctx) (d : iexp) → Set where
    CIFBEHole : ∀ {Δ d} →
      Σ[ u ∈ Nat ] Σ[ σ ∈ env ] Σ[ Γ ∈ tctx ]
        ((d == ⦇⦈⟨ u , σ ⟩) ×
         ((u :: b [ Γ ]) ∈ Δ) ×
         (Δ , ∅ ⊢ σ :s: Γ)
        )
       → cif-base Δ d
    CIFBNEHole : ∀ {Δ d} →
      Σ[ u ∈ Nat ] Σ[ σ ∈ env ] Σ[ Γ ∈ tctx ] Σ[ d' ∈ iexp ] Σ[ τ' ∈ typ ]
        ((d == ⦇⌜ d' ⌟⦈⟨ u , σ ⟩) ×
         (Δ , ∅ ⊢ d' :: τ') ×
         (d' final) ×
         ((u :: b [ Γ ]) ∈ Δ) ×
         (Δ , ∅ ⊢ σ :s: Γ)
        )
        → cif-base Δ d
    CIFBAp : ∀ {Δ d} →
      Σ[ d1 ∈ iexp ] Σ[ d2 ∈ iexp ] Σ[ τ2 ∈ typ ]
        ((d == d1 ∘ d2) ×
         (Δ , ∅ ⊢ d1 :: τ2 ==> b) ×
         (Δ , ∅ ⊢ d2 :: τ2) ×
         (d1 indet) ×
         (d2 final) ×
         ((τ3 τ4 τ3' τ4' : typ) (d1' : iexp) → d1 ≠ (d1' ⟨ τ3 ==> τ4 ⇒ τ3' ==> τ4' ⟩))
        )
        → cif-base Δ d
    CIFBFst : ∀{Δ d} →
      Σ[ d' ∈ iexp ] Σ[ τ2 ∈ typ ]
        ((d == fst d') ×
         (Δ , ∅ ⊢ d' :: b ⊗ τ2) ×
         (d' indet) ×
         (∀{d1 d2} → d' ≠ ⟨ d1 , d2 ⟩) ×
         (∀{d'' τ1 τ2 τ3 τ4} → d' ≠ (d'' ⟨ τ1 ⊗ τ2 ⇒ τ3 ⊗ τ4 ⟩))
        )
        → cif-base Δ d
    CIFBSnd : ∀{Δ d} →
        Σ[ d' ∈ iexp ] Σ[ τ1 ∈ typ ]
        ((d == snd d') ×
         (Δ , ∅ ⊢ d' :: τ1 ⊗ b) ×
         (d' indet) ×
         (∀{d1 d2} → d' ≠ ⟨ d1 , d2 ⟩) ×
         (∀{d'' τ1 τ2 τ3 τ4} → d' ≠ (d'' ⟨ τ1 ⊗ τ2 ⇒ τ3 ⊗ τ4 ⟩))
        )
        → cif-base Δ d
    CIFBCast : ∀ {Δ d} →
      Σ[ d' ∈ iexp ]
        ((d == d' ⟨ ⦇·⦈ ⇒ b ⟩) ×
         (Δ , ∅ ⊢ d' :: ⦇·⦈) ×
         (d' indet) ×
         ((d'' : iexp) (τ' : typ) → d' ≠ (d'' ⟨ τ' ⇒ ⦇·⦈ ⟩))
        )
        → cif-base Δ d
    CIFBFailedCast : ∀ {Δ d} →
      Σ[ d' ∈ iexp ] Σ[ τ' ∈ typ ]
        ((d == d' ⟨ τ' ⇒⦇⦈⇏ b ⟩) ×
         (Δ , ∅ ⊢ d' :: τ') ×
         (τ' ground) ×
         (τ' ≠ b)
        )
       → cif-base Δ d

  canonical-indeterminate-forms-base : ∀{Δ d} →
                                       Δ , ∅ ⊢ d :: b →
                                       d indet →
                                       cif-base Δ d
  canonical-indeterminate-forms-base TAConst ()
  canonical-indeterminate-forms-base (TAVar x₁) ()
  canonical-indeterminate-forms-base (TAAp wt wt₁) (IAp x ind x₁) = CIFBAp (_ , _ , _ , refl , wt , wt₁ , ind , x₁ , x)
  canonical-indeterminate-forms-base (TAEHole x x₁) IEHole = CIFBEHole (_ , _ , _ , refl , x , x₁)
  canonical-indeterminate-forms-base (TANEHole x wt x₁) (INEHole x₂) = CIFBNEHole (_ , _ , _ , _ , _ , refl , wt , x₂ , x , x₁)
  canonical-indeterminate-forms-base (TACast wt x) (ICastHoleGround x₁ ind x₂) = CIFBCast (_ , refl , wt , ind , x₁)
  canonical-indeterminate-forms-base (TAFailedCast x x₁ x₂ x₃) (IFailedCast x₄ x₅ x₆ x₇) = CIFBFailedCast (_ , _ , refl , x , x₅ , x₇)
  canonical-indeterminate-forms-base (TAFst wt) (IFst ind h1 h2) = CIFBFst (_ , _ , refl , wt , ind , h1 , h2)
  canonical-indeterminate-forms-base (TASnd wt) (ISnd ind h1 h2) = CIFBSnd (_ , _ , refl , wt , ind , h1 , h2)

  -- this type gives somewhat nicer syntax for the output of the canonical
  -- forms lemma for indeterminates at arrow type
  data cif-arr : (Δ : hctx) (d : iexp) (τ1 τ2 : typ) → Set where
    CIFAEHole : ∀{d Δ τ1 τ2} →
      Σ[ u ∈ Nat ] Σ[ σ ∈ env ] Σ[ Γ ∈ tctx ]
        ((d == ⦇⦈⟨ u , σ ⟩) ×
         ((u :: (τ1 ==> τ2) [ Γ ]) ∈ Δ) ×
         (Δ , ∅ ⊢ σ :s: Γ)
        )
      → cif-arr Δ d τ1 τ2
    CIFANEHole : ∀{d Δ τ1 τ2} →
      Σ[ u ∈ Nat ] Σ[ σ ∈ env ] Σ[ d' ∈ iexp ] Σ[ τ' ∈ typ ] Σ[ Γ ∈ tctx ]
        ((d == ⦇⌜ d' ⌟⦈⟨ u , σ ⟩) ×
         (Δ , ∅ ⊢ d' :: τ') ×
         (d' final) ×
         ((u :: (τ1 ==> τ2) [ Γ ]) ∈ Δ) ×
         (Δ , ∅ ⊢ σ :s: Γ)
        )
        → cif-arr Δ d τ1 τ2
    CIFAAp : ∀{d Δ τ1 τ2} →
      Σ[ d1 ∈ iexp ] Σ[ d2 ∈ iexp ] Σ[ τ2' ∈ typ ] Σ[ τ1 ∈ typ ] Σ[ τ2 ∈ typ ]
        ((d == d1 ∘ d2) ×
         (Δ , ∅ ⊢ d1 :: τ2' ==> (τ1 ==> τ2)) ×
         (Δ , ∅ ⊢ d2 :: τ2') ×
         (d1 indet) ×
         (d2 final) ×
         ((τ3 τ4 τ3' τ4' : typ) (d1' : iexp) → d1 ≠ (d1' ⟨ τ3 ==> τ4 ⇒ τ3' ==> τ4' ⟩))
        )
        → cif-arr Δ d τ1 τ2
    CIFAFst : ∀{Δ d τ1 τ2} →
      Σ[ d' ∈ iexp ] Σ[ τ' ∈ typ ]
        ((d == fst d') ×
         (Δ , ∅ ⊢ d' :: (τ1 ==> τ2) ⊗ τ') ×
         (d' indet) ×
         (∀{d1 d2} → d' ≠ ⟨ d1 , d2 ⟩) ×
         (∀{d'' τ1 τ2 τ3 τ4} → d' ≠ (d'' ⟨ τ1 ⊗ τ2 ⇒ τ3 ⊗ τ4 ⟩))
        )
        → cif-arr Δ d τ1 τ2
    CIFASnd : ∀{Δ d τ1 τ2} →
      Σ[ d' ∈ iexp ] Σ[ τ' ∈ typ ]
        ((d == snd d') ×
         (Δ , ∅ ⊢ d' :: τ' ⊗ (τ1 ==> τ2)) ×
         (d' indet) ×
         (∀{d1 d2} → d' ≠ ⟨ d1 , d2 ⟩) ×
         (∀{d'' τ1 τ2 τ3 τ4} → d' ≠ (d'' ⟨ τ1 ⊗ τ2 ⇒ τ3 ⊗ τ4 ⟩))
        )
        → cif-arr Δ d τ1 τ2
    CIFACast : ∀{d Δ τ1 τ2} →
      Σ[ d' ∈ iexp ] Σ[ τ1 ∈ typ ] Σ[ τ2 ∈ typ ] Σ[ τ1' ∈ typ ] Σ[ τ2' ∈ typ ]
        ((d == d' ⟨ (τ1' ==> τ2') ⇒ (τ1 ==> τ2) ⟩) ×
          (Δ , ∅ ⊢ d' :: τ1' ==> τ2') ×
          (d' indet) ×
          ((τ1' ==> τ2') ≠ (τ1 ==> τ2))
        )
       → cif-arr Δ d τ1 τ2
    CIFACastHole : ∀{d Δ τ1 τ2} →
      Σ[ d' ∈ iexp ]
        ((d == (d' ⟨ ⦇·⦈ ⇒ ⦇·⦈ ==> ⦇·⦈ ⟩)) ×
         (τ1 == ⦇·⦈) ×
         (τ2 == ⦇·⦈) ×
         (Δ , ∅ ⊢ d' :: ⦇·⦈) ×
         (d' indet) ×
         ((d'' : iexp) (τ' : typ) → d' ≠ (d'' ⟨ τ' ⇒ ⦇·⦈ ⟩))
        )
        → cif-arr Δ d τ1 τ2
    CIFAFailedCast : ∀{d Δ τ1 τ2} →
      Σ[ d' ∈ iexp ] Σ[ τ' ∈ typ ]
          ((d == (d' ⟨ τ' ⇒⦇⦈⇏ ⦇·⦈ ==> ⦇·⦈ ⟩) ) ×
           (τ1 == ⦇·⦈) ×
           (τ2 == ⦇·⦈) ×
           (Δ , ∅ ⊢ d' :: τ') ×
           (τ' ground) ×
           (τ' ≠ (⦇·⦈ ==> ⦇·⦈))
           )
          → cif-arr Δ d τ1 τ2

  canonical-indeterminate-forms-arr : ∀{Δ d τ1 τ2 } →
                                       Δ , ∅ ⊢ d :: (τ1 ==> τ2) →
                                       d indet →
                                       cif-arr Δ d τ1 τ2
  canonical-indeterminate-forms-arr (TAVar x₁) ()
  canonical-indeterminate-forms-arr (TALam _ wt) ()
  canonical-indeterminate-forms-arr (TAAp wt wt₁) (IAp x ind x₁) = CIFAAp (_ , _ , _ , _ , _ , refl , wt , wt₁ , ind , x₁ , x)
  canonical-indeterminate-forms-arr (TAEHole x x₁) IEHole = CIFAEHole (_ , _ , _ , refl , x , x₁)
  canonical-indeterminate-forms-arr (TANEHole x wt x₁) (INEHole x₂) = CIFANEHole (_ , _ , _ , _ , _ , refl , wt , x₂ , x , x₁)
  canonical-indeterminate-forms-arr (TACast wt x) (ICastArr x₁ ind) = CIFACast (_ , _ , _ , _ , _ , refl , wt , ind , x₁)
  canonical-indeterminate-forms-arr (TACast wt TCHole2) (ICastHoleGround x₁ ind GHole) = CIFACastHole (_ , refl , refl , refl , wt , ind , x₁)
  canonical-indeterminate-forms-arr (TAFailedCast x x₁ GHole x₃) (IFailedCast x₄ x₅ GHole x₇) = CIFAFailedCast (_ , _ , refl , refl , refl , x , x₅ , x₇)
  canonical-indeterminate-forms-arr (TAFst wt) (IFst ind h1 h2) = CIFAFst (_ , _ , refl , wt , ind , h1 , h2)
  canonical-indeterminate-forms-arr (TASnd wt) (ISnd ind h1 h2) = CIFASnd (_ , _ , refl , wt , ind , h1 , h2)

  -- this type gives somewhat nicer syntax for the output of the canonical
  -- forms lemma for indeterminates at hole type
  data cif-hole : (Δ : hctx) (d : iexp) → Set where
    CIFHEHole : ∀ {Δ d} →
      Σ[ u ∈ Nat ] Σ[ σ ∈ env ] Σ[ Γ ∈ tctx ]
        ((d == ⦇⦈⟨ u , σ ⟩) ×
         ((u :: ⦇·⦈ [ Γ ]) ∈ Δ) ×
         (Δ , ∅ ⊢ σ :s: Γ)
        )
      → cif-hole Δ d
    CIFHNEHole : ∀ {Δ d} →
      Σ[ u ∈ Nat ] Σ[ σ ∈ env ] Σ[ d' ∈ iexp ] Σ[ τ' ∈ typ ] Σ[ Γ ∈ tctx ]
        ((d == ⦇⌜ d' ⌟⦈⟨ u , σ ⟩) ×
         (Δ , ∅ ⊢ d' :: τ') ×
         (d' final) ×
         ((u :: ⦇·⦈ [ Γ ]) ∈ Δ) ×
         (Δ , ∅ ⊢ σ :s: Γ)
        )
      → cif-hole Δ d
    CIFHAp : ∀ {Δ d} →
      Σ[ d1 ∈ iexp ] Σ[ d2 ∈ iexp ] Σ[ τ2 ∈ typ ]
        ((d == d1 ∘ d2) ×
         (Δ , ∅ ⊢ d1 :: (τ2 ==> ⦇·⦈)) ×
         (Δ , ∅ ⊢ d2 :: τ2) ×
         (d1 indet) ×
         (d2 final) ×
         ((τ3 τ4 τ3' τ4' : typ) (d1' : iexp) → d1 ≠ (d1' ⟨ τ3 ==> τ4 ⇒ τ3' ==> τ4' ⟩))
        )
      → cif-hole Δ d
    CIFHFst : ∀{Δ d} →
      Σ[ d' ∈ iexp ] Σ[ τ' ∈ typ ]
       ((d == fst d') ×
        (Δ , ∅ ⊢ d' :: ⦇·⦈ ⊗ τ') ×
        (d' indet) ×
        (∀{d1 d2} → d' ≠ ⟨ d1 , d2 ⟩) ×
        (∀{d'' τ1 τ2 τ3 τ4} → d' ≠ (d'' ⟨ τ1 ⊗ τ2 ⇒ τ3 ⊗ τ4 ⟩))
       )
      → cif-hole Δ d
    CIFHSnd : ∀{Δ d} →
      Σ[ d' ∈ iexp ] Σ[ τ' ∈ typ ]
       ((d == snd d') ×
        (Δ , ∅ ⊢ d' :: τ' ⊗ ⦇·⦈) ×
        (d' indet) ×
        (∀{d1 d2} → d' ≠ ⟨ d1 , d2 ⟩) ×
        (∀{d'' τ1 τ2 τ3 τ4} → d' ≠ (d'' ⟨ τ1 ⊗ τ2 ⇒ τ3 ⊗ τ4 ⟩))
       )
      → cif-hole Δ d
    CIFHCast : ∀ {Δ d} →
      Σ[ d' ∈ iexp ] Σ[ τ' ∈ typ ]
        ((d == d' ⟨ τ' ⇒ ⦇·⦈ ⟩) ×
         (Δ , ∅ ⊢ d' :: τ') ×
         (τ' ground) ×
         (d' indet)
        )
      → cif-hole Δ d

  canonical-indeterminate-forms-hole : ∀{Δ d} →
                                       Δ , ∅ ⊢ d :: ⦇·⦈ →
                                       d indet →
                                       cif-hole Δ d
  canonical-indeterminate-forms-hole (TAVar x₁) ()
  canonical-indeterminate-forms-hole (TAAp wt wt₁) (IAp x ind x₁) = CIFHAp (_ , _ , _ , refl , wt , wt₁ , ind , x₁ , x)
  canonical-indeterminate-forms-hole (TAEHole x x₁) IEHole = CIFHEHole (_ , _ , _ , refl , x , x₁)
  canonical-indeterminate-forms-hole (TANEHole x wt x₁) (INEHole x₂) = CIFHNEHole (_ , _ , _ , _ , _ , refl , wt , x₂ , x , x₁)
  canonical-indeterminate-forms-hole (TACast wt x) (ICastGroundHole x₁ ind) = CIFHCast (_ , _ , refl , wt , x₁ , ind)
  canonical-indeterminate-forms-hole (TACast wt x) (ICastHoleGround x₁ ind ())
  canonical-indeterminate-forms-hole (TAFailedCast x x₁ () x₃) (IFailedCast x₄ x₅ x₆ x₇)
  canonical-indeterminate-forms-hole (TAFst wt) (IFst ind h1 h2) = CIFHFst (_ , _ , refl , wt , ind , h1 , h2)
  canonical-indeterminate-forms-hole (TASnd wt) (ISnd ind h1 h2) = CIFHSnd (_ , _ , refl , wt , ind , h1 , h2)

  -- this type gives somewhat nicer syntax for the output of the canonical
  -- forms lemma for indeterminates at product type
  data cif-prod : (Δ : hctx) (d : iexp) (τ1 τ2 : typ) → Set where
    CIFPEHole : ∀{d Δ τ1 τ2} →
      Σ[ u ∈ Nat ] Σ[ σ ∈ env ] Σ[ Γ ∈ tctx ]
        ((d == ⦇⦈⟨ u , σ ⟩) ×
         ((u :: (τ1 ⊗ τ2) [ Γ ]) ∈ Δ) ×
         (Δ , ∅ ⊢ σ :s: Γ)
        )
      → cif-prod Δ d τ1 τ2
    CIFPNEHole : ∀{d Δ τ1 τ2} →
      Σ[ u ∈ Nat ] Σ[ σ ∈ env ] Σ[ d' ∈ iexp ] Σ[ τ' ∈ typ ] Σ[ Γ ∈ tctx ]
        ((d == ⦇⌜ d' ⌟⦈⟨ u , σ ⟩) ×
         (Δ , ∅ ⊢ d' :: τ') ×
         (d' final) ×
         ((u :: (τ1 ⊗ τ2) [ Γ ]) ∈ Δ) ×
         (Δ , ∅ ⊢ σ :s: Γ)
        )
        → cif-prod Δ d τ1 τ2
    CIFPAp : ∀{d Δ τ1 τ2} →
      Σ[ d1 ∈ iexp ] Σ[ d2 ∈ iexp ] Σ[ τ2' ∈ typ ] Σ[ τ1 ∈ typ ] Σ[ τ2 ∈ typ ]
        ((d == d1 ∘ d2) ×
         (Δ , ∅ ⊢ d1 :: τ2' ==> (τ1 ⊗ τ2)) ×
         (Δ , ∅ ⊢ d2 :: τ2') ×
         (d1 indet) ×
         (d2 final) ×
         ((τ3 τ4 τ3' τ4' : typ) (d1' : iexp) → d1 ≠ (d1' ⟨ τ3 ==> τ4 ⇒ τ3' ==> τ4' ⟩))
        )
        → cif-prod Δ d τ1 τ2
    CIFPFst : ∀{Δ d τ1 τ2} →
      Σ[ d' ∈ iexp ] Σ[ τ' ∈ typ ]
        ((d == fst d') ×
         (Δ , ∅ ⊢ d' :: (τ1 ⊗ τ2) ⊗ τ') ×
         (d' indet) ×
         (∀{d1 d2} → d' ≠ ⟨ d1 , d2 ⟩) ×
         (∀{d'' τ1 τ2 τ3 τ4} → d' ≠ (d'' ⟨ τ1 ⊗ τ2 ⇒ τ3 ⊗ τ4 ⟩))
        )
        → cif-prod Δ d τ1 τ2
    CIFPSnd : ∀{Δ d τ1 τ2} →
      Σ[ d' ∈ iexp ] Σ[ τ' ∈ typ ]
        ((d == snd d') ×
         (Δ , ∅ ⊢ d' :: τ' ⊗ (τ1 ⊗ τ2)) ×
         (d' indet) ×
         (∀{d1 d2} → d' ≠ ⟨ d1 , d2 ⟩) ×
         (∀{d'' τ1 τ2 τ3 τ4} → d' ≠ (d'' ⟨ τ1 ⊗ τ2 ⇒ τ3 ⊗ τ4 ⟩))
        )
        → cif-prod Δ d τ1 τ2
    CIFPPair1 : ∀{Δ d τ1 τ2} →
      Σ[ d1 ∈ iexp ] Σ[ d2 ∈ iexp ]
        ((d == ⟨ d1 , d2 ⟩) ×
         (Δ , ∅ ⊢ d1 :: τ1) ×
         (Δ , ∅ ⊢ d2 :: τ2) ×
         d1 indet ×
         d2 final
        )
        → cif-prod Δ d τ1 τ2
    CIFPPair2 : ∀{Δ d τ1 τ2} →
      Σ[ d1 ∈ iexp ] Σ[ d2 ∈ iexp ]
        ((d == ⟨ d1 , d2 ⟩) ×
         (Δ , ∅ ⊢ d1 :: τ1) ×
         (Δ , ∅ ⊢ d2 :: τ2) ×
         d1 final ×
         d2 indet
        )
        → cif-prod Δ d τ1 τ2
    CIFPCast : ∀{d Δ τ1 τ2} →
      Σ[ d' ∈ iexp ] Σ[ τ1 ∈ typ ] Σ[ τ2 ∈ typ ] Σ[ τ1' ∈ typ ] Σ[ τ2' ∈ typ ]
        ((d == d' ⟨ (τ1' ⊗ τ2') ⇒ (τ1 ⊗ τ2) ⟩) ×
          (Δ , ∅ ⊢ d' :: τ1' ⊗ τ2') ×
          (d' indet) ×
          ((τ1' ⊗ τ2') ≠ (τ1 ⊗ τ2)) ×
          ((τ1' ⊗ τ2') ~ (τ1 ⊗ τ2))
        )
       → cif-prod Δ d τ1 τ2
    CIFPCastHole : ∀{d Δ τ1 τ2} →
      Σ[ d' ∈ iexp ]
        ((d == (d' ⟨ ⦇·⦈ ⇒ ⦇·⦈ ⊗ ⦇·⦈ ⟩)) ×
         (τ1 == ⦇·⦈) ×
         (τ2 == ⦇·⦈) ×
         (Δ , ∅ ⊢ d' :: ⦇·⦈) ×
         (d' indet) ×
         ((d'' : iexp) (τ' : typ) → d' ≠ (d'' ⟨ τ' ⇒ ⦇·⦈ ⟩))
        )
        → cif-prod Δ d τ1 τ2
    CIFPFailedCast : ∀{d Δ τ1 τ2} →
      Σ[ d' ∈ iexp ] Σ[ τ' ∈ typ ]
          ((d == (d' ⟨ τ' ⇒⦇⦈⇏ ⦇·⦈ ⊗ ⦇·⦈ ⟩) ) ×
           (τ1 == ⦇·⦈) ×
           (τ2 == ⦇·⦈) ×
           (Δ , ∅ ⊢ d' :: τ') ×
           (τ' ground) ×
           (τ' ≠ (⦇·⦈ ⊗ ⦇·⦈) ×
           d' final))
          → cif-prod Δ d τ1 τ2

  canonical-indeterminate-forms-prod : ∀{Δ d τ1 τ2 } →
                                       Δ , ∅ ⊢ d :: (τ1 ⊗ τ2) →
                                       d indet →
                                       cif-prod Δ d τ1 τ2
  canonical-indeterminate-forms-prod (TAVar x₁) ()
  canonical-indeterminate-forms-prod (TAAp wt wt₁) (IAp x ind x₁) = CIFPAp (_ , _ , _ , _ , _ , refl , wt , wt₁ , ind , x₁ , x)
  canonical-indeterminate-forms-prod (TAEHole x x₁) IEHole = CIFPEHole (_ , _ , _ , refl , x , x₁)
  canonical-indeterminate-forms-prod (TANEHole x wt x₁) (INEHole x₂) = CIFPNEHole (_ , _ , _ , _ , _ , refl , wt , x₂ , x , x₁)
  canonical-indeterminate-forms-prod (TACast wt x) (ICastProd x₁ ind) = CIFPCast (_ , _ , _ , _ , _ , refl , wt , ind , x₁ , x)
  canonical-indeterminate-forms-prod (TACast wt TCHole2) (ICastHoleGround x₁ ind GProd) = CIFPCastHole (_ , refl , refl , refl , wt , ind , x₁)
  canonical-indeterminate-forms-prod (TAFailedCast wt x GProd x₂) (IFailedCast x₃ x₄ GProd x₆) = CIFPFailedCast (_ , _ , refl , refl , refl , wt , x₄ , x₆ , x₃)
  canonical-indeterminate-forms-prod (TAFst wt) (IFst ind h1 h2) = CIFPFst (_ , _ , refl , wt , ind , h1 , h2)
  canonical-indeterminate-forms-prod (TASnd wt) (ISnd ind h1 h2) = CIFPSnd (_ , _ , refl , wt , ind , h1 , h2)
  canonical-indeterminate-forms-prod (TAPair wt wt₁) (IPair1 ind x) = CIFPPair1 (_ , _ , refl , wt , wt₁ , ind , x)
  canonical-indeterminate-forms-prod (TAPair wt wt₁) (IPair2 x ind) = CIFPPair2 (_ , _ , refl , wt , wt₁ , x , ind)

  canonical-indeterminate-forms-coverage : ∀{Δ d τ} →
                                           Δ , ∅ ⊢ d :: τ →
                                           d indet →
                                           τ ≠ b →
                                           ((τ1 : typ) (τ2 : typ) → τ ≠ (τ1 ==> τ2)) →
                                           τ ≠ ⦇·⦈ →
                                           ((τ1 : typ) (τ2 : typ) → τ ≠ (τ1 ⊗ τ2)) →
                                           ⊥
  canonical-indeterminate-forms-coverage TAConst () nb na nh
  canonical-indeterminate-forms-coverage (TAVar x₁) () nb na nh
  canonical-indeterminate-forms-coverage (TALam _ wt) () nb na nh
  canonical-indeterminate-forms-coverage {τ = b} (TAAp wt wt₁) (IAp x ind x₁) nb na nh _ = nb refl
  canonical-indeterminate-forms-coverage {τ = ⦇·⦈} (TAAp wt wt₁) (IAp x ind x₁) nb na nh _ = nh refl
  canonical-indeterminate-forms-coverage {τ = τ ==> τ₁} (TAAp wt wt₁) (IAp x ind x₁) nb na nh _ = na τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = b} (TAEHole x x₁) IEHole nb na nh _ = nb refl
  canonical-indeterminate-forms-coverage {τ = ⦇·⦈} (TAEHole x x₁) IEHole nb na nh _ = nh refl
  canonical-indeterminate-forms-coverage {τ = τ ==> τ₁} (TAEHole x x₁) IEHole nb na nh _ = na τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = b} (TANEHole x wt x₁) (INEHole x₂) nb na nh _ = nb refl
  canonical-indeterminate-forms-coverage {τ = ⦇·⦈} (TANEHole x wt x₁) (INEHole x₂) nb na nh _ = nh refl
  canonical-indeterminate-forms-coverage {τ = τ ==> τ₁} (TANEHole x wt x₁) (INEHole x₂) nb na nh _ = na τ τ₁ refl
  canonical-indeterminate-forms-coverage (TACast wt x) (ICastArr x₁ ind) nb na nh _ = na _ _ refl
  canonical-indeterminate-forms-coverage (TACast wt x) (ICastGroundHole x₁ ind) nb na nh _ = nh refl
  canonical-indeterminate-forms-coverage {τ = b} (TACast wt x) (ICastHoleGround x₁ ind x₂) nb na nh _ = nb refl
  canonical-indeterminate-forms-coverage {τ = ⦇·⦈} (TACast wt x) (ICastHoleGround x₁ ind x₂) nb na nh _ = nh refl
  canonical-indeterminate-forms-coverage {τ = τ ==> τ₁} (TACast wt x) (ICastHoleGround x₁ ind x₂) nb na nh _ = na τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = b} (TAFailedCast x x₁ x₂ x₃) (IFailedCast x₄ x₅ x₆ x₇) z _ _ _ = z refl
  canonical-indeterminate-forms-coverage {τ = ⦇·⦈} (TAFailedCast x x₁ x₂ x₃) (IFailedCast x₄ x₅ x₆ x₇) _ _ z _ = z refl
  canonical-indeterminate-forms-coverage {τ = τ ==> τ₁} (TAFailedCast x x₁ x₂ x₃) (IFailedCast x₄ x₅ x₆ x₇) _ z _ _ = z τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = b} (TAFst wt) (IFst ind x _) nb na nh np = nb refl
  canonical-indeterminate-forms-coverage {τ = b} (TASnd wt) (ISnd ind x _) nb na nh np = nb refl
  canonical-indeterminate-forms-coverage {τ = ⦇·⦈} (TAFst wt) (IFst ind x _) nb na nh np = nh refl
  canonical-indeterminate-forms-coverage {τ = ⦇·⦈} (TASnd wt) (ISnd ind x _) nb na nh np = nh refl
  canonical-indeterminate-forms-coverage {τ = τ ==> τ₁} (TAFst wt) (IFst ind x _) nb na nh np = na τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = τ ==> τ₁} (TASnd wt) (ISnd ind x _) nb na nh np = na τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = τ ⊗ τ₁} (TAAp wt wt₁) (IAp x ind x₁) nb na nh np = np τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = τ ⊗ τ₁} (TAEHole x x₁) IEHole nb na nh np = np τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = τ ⊗ τ₁} (TANEHole x wt x₁) (INEHole x₂) nb na nh np = np τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = τ ⊗ τ₁} (TACast wt x) (ICastProd x₁ ind) nb na nh np = np τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = τ ⊗ τ₁} (TACast wt x) (ICastHoleGround x₁ ind x₂) nb na nh np = np τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = τ ⊗ τ₁} (TAFailedCast wt x x₁ x₂) (IFailedCast x₃ x₄ x₅ x₆) nb na nh np = np τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = τ ⊗ τ₁} (TAFst wt) (IFst ind x _) nb na nh np = np τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = τ ⊗ τ₁} (TASnd wt) (ISnd ind x _) nb na nh np = np τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = τ ⊗ τ₁} (TAPair wt wt₁) (IPair1 ind x) nb na nh np = np τ τ₁ refl
  canonical-indeterminate-forms-coverage {τ = τ ⊗ τ₁} (TAPair wt wt₁) (IPair2 x ind) nb na nh np = np τ τ₁ refl


open import Agda.Builtin.Equality

postulate
  A : Set

id : A → A
id x = x

mutual
  ?Y : A → A → A
  ?Y = _

  ?X : A → A → A
  ?X = _

  -- This tries to solve ?X x x := ?Y x y, which fails but prunes
  -- ?Y x y := ?Z x. Failing ?X := ?Y we then try the other direction
  -- without realising that ?Y has been instantiated and (re)solve
  -- ?Y x y := ?X x x, leaving ?Z hanging!
  -- The `id` call is to make sure we get into `compareAtom`. The
  -- corresponding code in `compareTerm` does the right thing.
  constr₁ : ∀ x y → id (?X x x) ≡ id (?Y x y)
  constr₁ x y = refl

  -- We can then solve ?X.
  constr₂ : ∀ x y → ?X x y ≡ x
  constr₂ x y = refl

-- And check that they really are solved

checkY : ?Y ≡ λ x y → x
checkY = refl

checkX : ?X ≡ λ x y → x
checkX = refl

-- ...but we still have ?Z unsolved.


{-# OPTIONS --allow-unsolved-metas #-}
module ExtractDependent where
open import Agda.Builtin.Nat
open import Agda.Builtin.Bool
open import Agda.Builtin.String

apply : (A : Set) -> (B : A -> Set) ->
            ((x : A) -> B x) -> (a : A) -> B a
apply A B f a = f a

applySameName : (A : Set) -> (A : Set) -> (B : A -> Set) ->
             (h : Set) -> (h : (x : A) -> B x) -> (a : A) -> B a
applySameName C A B g f a = f a

-- TODO : Try same test with {A} {B} once the parser can handle that.
applyImp : {A : Set} -> {B : A -> Set} ->
            ((x : A) -> B x) -> (y : A) -> B y
applyImp f a = f a

applyImpSameName : {A : Set} -> {A : Set} -> {B : A -> Set} ->
             (h : Set) -> (h : (x : A) -> B x) -> (a : A) -> B a
applyImpSameName A B h = B h


------------------------------------------------------------------------
-- A partial order
------------------------------------------------------------------------

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

open import Prelude

module Delay-monad.Partial-order {a} {A : Type a} where

open import Equality.Propositional as E
open import Logical-equivalence using (_⇔_)
open import Prelude.Size

open import Bijection equality-with-J using (_↔_)
open import Double-negation equality-with-J
open import Excluded-middle equality-with-J
open import Function-universe equality-with-J hiding (id; _∘_)
open import H-level equality-with-J
open import H-level.Closure equality-with-J
open import Monad equality-with-J

open import Delay-monad
open import Delay-monad.Bisimilarity as B
  hiding (reflexive; symmetric; laterˡ⁻¹; laterʳ⁻¹)
open import Delay-monad.Bisimilarity.Alternative
open import Delay-monad.Bisimilarity.Negative
import Delay-monad.Termination as T

-- An ordering relation.
--
-- Capretta defines a pointwise logically equivalent relation in
-- "General Recursion via Coinductive Types".
--
-- Benton, Kennedy and Varming define a relation that is perhaps
-- pointwise logically equivalent in "Some Domain Theory and
-- Denotational Semantics in Coq".

infix 4 [_]_⊑_ [_]_⊑′_ _⊑_ _⊑′_

mutual

  data [_]_⊑_ (i : Size) : Delay A ∞ → Delay A ∞ → Type a where
    now    : ∀ {x} → [ i ] now x ⊑ now x
    laterʳ : ∀ {x y} → [ i ] x ⊑ force y → [ i ] x ⊑ later y
    laterˡ : ∀ {x y} → [ i ] force x ⊑′ y → [ i ] later x ⊑ y

  record [_]_⊑′_ (i : Size) (x y : Delay A ∞) : Type a where
    coinductive
    field
      force : {j : Size< i} → [ j ] x ⊑ y

open [_]_⊑′_ public

_⊑_ : Delay A ∞ → Delay A ∞ → Type a
_⊑_ = [ ∞ ]_⊑_

_⊑′_ : Delay A ∞ → Delay A ∞ → Type a
_⊑′_ = [ ∞ ]_⊑′_

-- A derived "constructor".

later-cong : ∀ {i x y} →
             [ i ] force x ⊑′ force y → [ i ] later x ⊑ later y
later-cong p = laterʳ (laterˡ p)

-- Termination predicates.

Terminates : Size → Delay A ∞ → A → Type a
Terminates i x y = [ i ] now y ⊑ x

_⇓_ : Delay A ∞ → A → Type a
_⇓_ = Terminates ∞

-- If x terminates with the values y and z, then y is equal to z.

⇓→⇓→≡ : ∀ {i x y z} → Terminates i x y → Terminates i x z → y ≡ z
⇓→⇓→≡ now        now        = refl
⇓→⇓→≡ (laterʳ p) (laterʳ q) = ⇓→⇓→≡ p q

-- If x is smaller than or equal to now y, and x terminates, then
-- x terminates with the value y.

⊑now→⇓→⇓ : ∀ {i x} {y z : A} →
           x ⊑ now y → Terminates i x z → Terminates i x y
⊑now→⇓→⇓ now        now        = now
⊑now→⇓→⇓ (laterˡ p) (laterʳ q) = laterʳ (⊑now→⇓→⇓ (force p) q)

-- The notion of termination defined here is pointwise isomorphic to
-- the one defined in Delay-monad.Termination.

⇓↔⇓ : ∀ {i x y} → Terminates i x y ↔ T.Terminates i x y
⇓↔⇓ = record
  { surjection = record
    { logical-equivalence = record
      { to   = to
      ; from = from
      }
    ; right-inverse-of = to∘from
    }
  ; left-inverse-of = from∘to
  }
  where
  to : ∀ {i x y} → Terminates i x y → T.Terminates i x y
  to now        = now
  to (laterʳ p) = laterʳ (to p)

  from : ∀ {i x y} → T.Terminates i x y → Terminates i x y
  from now        = now
  from (laterʳ p) = laterʳ (from p)

  from∘to : ∀ {i x y} (p : Terminates i x y) → from (to p) ≡ p
  from∘to now        = refl
  from∘to (laterʳ p) = cong laterʳ (from∘to p)

  to∘from : ∀ {i x y} (p : T.Terminates i x y) → to (from p) ≡ p
  to∘from now        = refl
  to∘from (laterʳ p) = cong laterʳ (to∘from p)

-- Terminates i is pointwise isomorphic to Terminates ∞.

Terminates↔⇓ : ∀ {i x y} → Terminates i x y ↔ x ⇓ y
Terminates↔⇓ {i} {x} {y} =
  Terminates i x y    ↝⟨ ⇓↔⇓ ⟩
  T.Terminates i x y  ↝⟨ T.Terminates↔⇓ ⟩
  x T.⇓ y             ↝⟨ inverse ⇓↔⇓ ⟩□
  x ⇓ y               □

-- The computation never is smaller than or equal to all other
-- computations.

never⊑ : ∀ {i} x → [ i ] never ⊑ x
never⊑ (now x)   = laterˡ λ { .force → never⊑ (now x) }
never⊑ (later x) = later-cong λ { .force → never⊑ (force x) }

-- The computation never does not terminate.

now⋢never : ∀ {i x} → ¬ Terminates i never x
now⋢never (laterʳ p) = now⋢never p

-- One can remove later constructors.

laterˡ⁻¹ : ∀ {i} {j : Size< i} {x y} →
           [ i ] later x ⊑ y →
           [ j ] force x ⊑ y
laterˡ⁻¹ (laterʳ p) = laterʳ (laterˡ⁻¹ p)
laterˡ⁻¹ (laterˡ p) = force p

laterʳ⁻¹ : ∀ {i x y} →
           [ i ] x ⊑ later y →
           [ i ] x ⊑ force y
laterʳ⁻¹ (laterʳ p) = p
laterʳ⁻¹ (laterˡ p) = laterˡ λ { .force → laterʳ⁻¹ (force p) }

later-cong⁻¹ : ∀ {i} {j : Size< i} {x y} →
               [ i ] later x ⊑ later y →
               [ j ] force x ⊑ force y
later-cong⁻¹ p = laterʳ⁻¹ (laterˡ⁻¹ p)

-- Weak bisimilarity is contained in the ordering relation.

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

-- The ordering relation is antisymmetric (with respect to weak
-- bisimilarity).

antisymmetric : ∀ {i x y} →
                [ i ] x ⊑ y → [ i ] y ⊑ x → [ i ] x ≈ y
antisymmetric {x = now   x} {y = now  .x} now        _          = now
antisymmetric {x = now   x} {y = later y} (laterʳ p) q          = laterʳ (_↔_.to ⇓↔⇓ p)
antisymmetric {x = later x} {y = now   y} p          (laterʳ q) = laterˡ (B.symmetric (_↔_.to ⇓↔⇓ q))
antisymmetric {x = later x} {y = later y} p          q          =
  later λ { .force → antisymmetric (later-cong⁻¹ p) (later-cong⁻¹ q) }

-- An alternative characterisation of weak bisimilarity.

≈⇔⊑×⊒ : ∀ {i x y} → [ i ] x ≈ y ⇔ ([ i ] x ⊑ y × [ i ] y ⊑ x)
≈⇔⊑×⊒ = record
  { to   = λ p → ≈→⊑ p , ≈→⊑ (B.symmetric p)
  ; from = uncurry antisymmetric
  }

-- The ordering relation is reflexive.

reflexive : ∀ {i} x → [ i ] x ⊑ x
reflexive (now x)   = now
reflexive (later x) = later-cong λ { .force → reflexive (force x) }

-- Certain instances of symmetry also hold.

symmetric : ∀ {i} {x : A} {y} →
            Terminates i y x → [ i ] y ⊑ now x
symmetric now        = now
symmetric (laterʳ p) = laterˡ λ { .force → symmetric p }

-- The ordering relation is transitive.

transitive : ∀ {i} {x y z : Delay A ∞} →
             [ i ] x ⊑ y → y ⊑ z → [ i ] x ⊑ z
transitive p          now        = p
transitive p          (laterʳ q) = laterʳ (transitive p q)
transitive (laterʳ p) (laterˡ q) = transitive p (force q)
transitive (laterˡ p) q          = laterˡ λ { .force →
                                     transitive (force p) q }

-- The termination relation respects weak bisimilarity.

⇓-respects-≈ : ∀ {i x y z} → Terminates i x z → x ≈ y → Terminates i y z
⇓-respects-≈ now        q = ≈→⊑ q
⇓-respects-≈ (laterʳ p) q = ⇓-respects-≈ p (B.laterˡ⁻¹ q)

-- The ordering relation respects weak bisimilarity.

transitive-≈⊑ : ∀ {i x y z} → [ i ] x ≈ y → y ⊑ z → [ i ] x ⊑ z
transitive-≈⊑ p q = transitive (≈→⊑ p) q

transitive-⊑≈ : ∀ {i x y z} → [ i ] x ⊑ y → y ≈ z → [ i ] x ⊑ z
transitive-⊑≈ p          now        = p
transitive-⊑≈ (laterʳ p) (later  q) = laterʳ (transitive-⊑≈ p (force q))
transitive-⊑≈ (laterˡ p) q          = laterˡ λ { .force →
                                        transitive-⊑≈ (force p) q }
transitive-⊑≈ (laterʳ p) (laterˡ q) = transitive-⊑≈ p q
transitive-⊑≈ p          (laterʳ q) = laterʳ (transitive-⊑≈ p q)

-- There is a transitivity-like function that produces an ordering
-- proof from one weak bisimilarity proof and one ordering proof, in
-- such a way that the size of the ordering proof is preserved, iff A
-- is uninhabited.

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

size-preserving-transitivity-≈⊑ʳ⇔uninhabited : Transitivity-≈⊑ʳ ⇔ ¬ A
size-preserving-transitivity-≈⊑ʳ⇔uninhabited = record
  { to   = Transitivity-≈⊑ʳ                                    ↝⟨ (λ trans {i x} →

               [ i ] later (record { force = now x }) ∼ never        ↝⟨ ≈→⊑ ∘ ∼→ ⟩
               [ i ] later (record { force = now x }) ⊑ never        ↝⟨ trans (laterʳ now) ⟩
               [ i ] now x ⊑ never                                   ↝⟨ _↔_.to ⇓↔⇓ ⟩□
               [ i ] now x ≈ never                                   □) ⟩

           Laterˡ⁻¹-∼≈′                                        ↝⟨ _⇔_.to size-preserving-laterˡ⁻¹-∼≈′⇔uninhabited ⟩

           ¬ A                                                 □
  ; from = ¬ A               ↝⟨ uninhabited→trivial ⟩
           (∀ x y → x ≈ y)   ↝⟨ (λ trivial _ _ → ≈→⊑ (trivial _ _)) ⟩
           (∀ x y → x ⊑ y)   ↝⟨ (λ trivial {_ _ _ _} _ _ → trivial _ _) ⟩□
           Transitivity-≈⊑ʳ  □
  }

-- Transitivity can be made size-preserving in the second argument iff
-- A is uninhabited.

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

size-preserving-transitivityʳ⇔uninhabited : Transitivityʳ ⇔ ¬ A
size-preserving-transitivityʳ⇔uninhabited = record
  { to   = Transitivityʳ     ↝⟨ _∘ ≈→⊑ ⟩
           Transitivity-≈⊑ʳ  ↝⟨ _⇔_.to size-preserving-transitivity-≈⊑ʳ⇔uninhabited ⟩□
           ¬ A               □
  ; from = ¬ A              ↝⟨ uninhabited→trivial ⟩
           (∀ x y → x ≈ y)  ↝⟨ (λ trivial _ _ → ≈→⊑ (trivial _ _)) ⟩
           (∀ x y → x ⊑ y)  ↝⟨ (λ trivial {_ _ _ _} _ _ → trivial _ _) ⟩□
           Transitivityʳ    □
  }

-- There is a transitivity-like function that produces an ordering
-- proof from one ordering proof and one weak bisimilarity proof, in
-- such a way that the size of the weak bisimilarity proof is
-- preserved, iff A is uninhabited.

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

size-preserving-transitivity-⊑≈ʳ⇔uninhabited : Transitivity-⊑≈ʳ ⇔ ¬ A
size-preserving-transitivity-⊑≈ʳ⇔uninhabited = record
  { to   = Transitivity-⊑≈ʳ                                    ↝⟨ (λ trans {i x} →

               [ i ] later (record { force = now x }) ∼ never        ↝⟨ ∼→ ⟩
               [ i ] later (record { force = now x }) ≈ never        ↝⟨ trans (laterʳ now) ⟩
               [ i ] now x ⊑ never                                   ↝⟨ _↔_.to ⇓↔⇓ ⟩□
               [ i ] now x ≈ never                                   □) ⟩

           Laterˡ⁻¹-∼≈′                                        ↝⟨ _⇔_.to size-preserving-laterˡ⁻¹-∼≈′⇔uninhabited ⟩

           ¬ A                                                 □
  ; from = ¬ A               ↝⟨ uninhabited→trivial ⟩
           (∀ x y → x ≈ y)   ↝⟨ (λ trivial _ _ → ≈→⊑ (trivial _ _)) ⟩
           (∀ x y → x ⊑ y)   ↝⟨ (λ trivial {_ _ _ _} _ _ → trivial _ _) ⟩□
           Transitivity-⊑≈ʳ  □
  }

-- An alternative characterisation of the ordering relation.
--
-- Capretta proves a similar result in "General Recursion via
-- Coinductive Types".
--
-- One might wonder if the equivalence can be made size-preserving in
-- some way. However, note that x ⇓ y is in bijective correspondence
-- with Terminates i x y for any size i (see Terminates↔⇓).

⊑⇔⇓→⇓ : ∀ {x y} → x ⊑ y ⇔ (∀ z → x ⇓ z → y ⇓ z)
⊑⇔⇓→⇓ = record
  { to   = to
  ; from = from _
  }
  where
  to : ∀ {x y} → x ⊑ y → ∀ z → x ⇓ z → y ⇓ z
  to p          z now   = p
  to (laterʳ p) z q          = laterʳ (to p z q)
  to (laterˡ p) z (laterʳ q) = to (force p) z q

  from : ∀ {i} x {y} → (∀ z → x ⇓ z → y ⇓ z) → [ i ] x ⊑ y
  from (now x)   p = p x now
  from (later x) p = laterˡ λ { .force →
                       from (force x) (λ z q → p z (laterʳ q)) }

-- An alternative characterisation of weak bisimilarity.
--
-- Capretta proves a similar result in "General Recursion via
-- Coinductive Types".

≈⇔≈₂ : {x y : Delay A ∞} → x ≈ y ⇔ x ≈₂ y
≈⇔≈₂ {x} {y} =
  x ≈ y                                                  ↝⟨ ≈⇔⊑×⊒ ⟩
  x ⊑ y × y ⊑ x                                          ↝⟨ ⊑⇔⇓→⇓ ×-cong ⊑⇔⇓→⇓ ⟩
  (∀ z → x ⇓ z → y ⇓ z) × (∀ z → y ⇓ z → x ⇓ z)          ↝⟨ ∀-cong _ (λ _ → →-cong _ (from-bijection ⇓↔⇓) (from-bijection ⇓↔⇓))
                                                              ×-cong
                                                            ∀-cong _ (λ _ → →-cong _ (from-bijection ⇓↔⇓) (from-bijection ⇓↔⇓)) ⟩
  (∀ z → x T.⇓ z → y T.⇓ z) × (∀ z → y T.⇓ z → x T.⇓ z)  ↝⟨ record { to   = uncurry λ to from z → record { to = to z; from = from z }
                                                                   ; from = λ hyp → _⇔_.to ∘ hyp , _⇔_.from ∘ hyp
                                                                   } ⟩□
  (∀ z → x T.⇓ z ⇔ y T.⇓ z)                              □

-- If A is a set, then every computation is weakly bisimilar to either
-- never or now something (assuming excluded middle and
-- extensionality).

⇑⊎⇓ :
  Excluded-middle a → E.Extensionality a a →
  Is-set A → (x : Delay A ∞) → never ≈ x ⊎ ∃ λ y → x T.⇓ y
⇑⊎⇓ em ext A-set x =
  ⊎-map (_⇔_.from ≈⇔≈₂) id $
  Excluded-middle→Double-negation-elimination em
    (⊎-closure-propositional
       (λ { x⇑ (y , x⇓y) →
            now≉never (now y  ≈⟨ x⇓y ⟩
                       x      ≈⟨ B.symmetric (_⇔_.from ≈⇔≈₂ x⇑) ⟩∎
                       never  ∎) })
       (≈₂-propositional ext A-set)
       (T.∃-Terminates-propositional A-set))
    (⊎-map (_⇔_.to ≈⇔≈₂) id ⟨$⟩ T.¬¬[⇑⊎⇓] x)


{-# OPTIONS --prop #-}

postulate
  f : Prop → Prop
  P : Prop₁

x : Prop
x = f P

-- WAS:
-- Set₁ != Set
-- when checking that the expression P has type Prop

-- SHOULD BE:
-- Prop₁ != Prop
-- when checking that the expression P has type Prop


{- 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 Haskell.Modules.RWS.RustAnyHow where

open import Haskell.Modules.RWS
open import Haskell.Prelude

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

ok   : A → RWS Ev Wr St (Either B A)
ok   = pure ∘ Right

bail : B → RWS Ev Wr St (Either B A)
bail = pure ∘ Left

infixl 4 _∙?∙_
_∙?∙_ : RWS Ev Wr St (Either C A) → (A → RWS Ev Wr St (Either C B)) → RWS Ev Wr St (Either C B)
_∙?∙_ = RWS-ebind

infixl 4 _∙^∙_
_∙^∙_ : RWS Ev Wr St (Either B A) → (B → B) → RWS Ev Wr St (Either B A)
m ∙^∙ f = do
  x ← m
  either (bail ∘ f) ok x


module Human.Test where

open import Human.Humanity

-- sum 7
-- 0 + 1 + 2 + 3 + 4 + 5 + 6

-- function sum(x) {
  -- var result = 0;
  -- for (var i = 0; i < 10; ++i) {
    -- result = result + i;
  -- }
  -- return result;
-- }

sum : Nat → Nat
sum i =
  init 0
  for i from 0 to 10 do:
    λ result → result + 1


module TelescopingLet4 where

module Star where
  ★ : Set₁
  ★ = Set

  ★₁ : Set₂
  ★₁ = Set₁

data D5 (open Star using (★₁)) : ★₁ where


module TermShape where

open import Relation.Unary using (_∈_; _⊆_)
open import Size
open import Library
open import Terms
open import Substitution

-- Evaluation contexts.

data ECxt (Γ : Cxt) : (a b : Ty) → Set where
  appl  : ∀ {a b} (u : Tm Γ a)  → ECxt Γ (a →̂ b) b

-- Ehole Et E t ~~ Et = E[t]

data Ehole {Γ : Cxt} : {a b : Ty} → Tm Γ b → ECxt Γ a b → Tm Γ a → Set where
  appl  : ∀ {a b} {t : Tm Γ (a →̂ b)} (u : Tm Γ a)  → Ehole (app t u) (appl u) t

-- Evaluation contexts are closed under substitution.

substEC : ∀ {i vt Γ Δ a b} → (σ : RenSub {i} vt Γ Δ) → ECxt Γ a b → ECxt Δ a b
substEC σ (appl u) = appl (subst σ u)

substEh : ∀ {i vt Γ Δ a b} → (σ : RenSub {i} vt Γ Δ) → ∀ {E}{Et : Tm Γ b}{t : Tm Γ a} → (Eh : Ehole Et E t)
            → Ehole (subst σ Et) (substEC σ E) (subst σ t)
substEh σ (appl u) = appl (subst σ u)

mkEHole : ∀ {Γ} {a b} (E : ECxt Γ a b) {t} → ∃ λ E[t] → Ehole E[t] E t
mkEHole (appl u)  = _ , appl u

_[_] : ∀ {Γ} {a b} (E : ECxt Γ a b) (t : Tm Γ a) → Tm Γ b
E [ t ] = proj₁ (mkEHole E {t})

data ECxt* (Γ : Cxt) : Ty → Ty → Set where
  [] : ∀ {a} → ECxt* Γ a a
  _∷_ : ∀ {a₀ a₁ a₂} → ECxt Γ a₀ a₁ → ECxt* Γ a₁ a₂ → ECxt* Γ a₀ a₂

_[_]* : ∀ {Γ} {a b} (E : ECxt* Γ a b) (t : Tm Γ a) → Tm Γ b
[] [ t ]* = t
(E ∷ Es) [ t ]* = Es [ E [ t ] ]*

_++*_ : ∀ {Γ a b c} → ECxt* Γ a b → ECxt* Γ b c → ECxt* Γ a c
[] ++* ys = ys
(x ∷ xs) ++* ys = x ∷ (xs ++* ys)

_∷r_ : ∀ {Γ a b c} → ECxt* Γ a b → ECxt Γ b c → ECxt* Γ a c
xs ∷r x = xs ++* (x ∷ [])

data Ehole* {Γ : Cxt} : {a b : Ty} → Tm Γ b → ECxt* Γ a b → Tm Γ a → Set where
  [] : ∀ {a} {t : Tm Γ a} → Ehole* t [] t
  _∷_ : ∀ {a b c t} {E : ECxt Γ b c} {Es : ECxt* Γ a b} {EEst Est}
        → Ehole EEst E Est → Ehole* Est Es t → Ehole* EEst (Es ∷r E) t

-- Inductive definition of strong normalization.

-- Parameterized evaluation contexts

data PCxt {Γ : Cxt} (P : ∀{c} → Tm Γ c → Set) : {a b : Ty} → Tm Γ b → ECxt Γ a b → Tm Γ a → Set where

  appl  : ∀ {a b u}{t : Tm _ (a →̂ b)}
          → (𝒖 : P u)
          → PCxt P (app t u) (appl u) t

-- Parameterized neutral terms.

data PNe {Γ} (P : ∀{c} → Tm Γ c → Set) {b} : Tm Γ b → Set where

  var  : ∀ x                              → PNe P (var x)

  elim : ∀ {a} {t : Tm Γ a} {E Et}
         → (𝒏 : PNe P t) (𝑬𝒕 : PCxt P Et E t) → PNe P Et

-- Parametrized weak head reduction

infix 10 _/_⇒_

data _/_⇒_ {Γ} (P : ∀{c} → Tm Γ c → Set): ∀ {a} → Tm Γ a  → Tm Γ a → Set where

  β     : ∀ {a b}{t : Tm (a ∷ Γ) b}{u}
          → (𝒖 : P u)
          → P / (app (abs t) u) ⇒ subst0 u t

  cong  : ∀ {a b t t' Et Et'}{E : ECxt Γ a b}
          → (𝑬𝒕 : Ehole Et E t)
          → (𝑬𝒕' : Ehole Et' E t')
          → (t⇒ : P / t ⇒ t')
          → P / Et ⇒ Et'

-- Weak head reduction is deterministic.

detP⇒ : ∀ {a Γ} {P : ∀ {c} → Tm Γ c → Set} {t t₁ t₂ : Tm Γ a}
       → (t⇒₁ : P / t ⇒ t₁) (t⇒₂ : P / t ⇒ t₂) → t₁ ≡ t₂
{-
detP⇒ (β 𝒖) (β 𝒖₁) = ≡.refl
detP⇒ (β 𝒖) (cong (appl u) (appl .u) (cong () 𝑬𝒕' d'))
detP⇒ (cong (appl u) (appl .u) (cong () 𝑬𝒕' d)) (β 𝒖)
detP⇒ (cong (appl u) (appl .u) d) (cong (appl .u) (appl .u) d') = ≡.cong (λ t → app t u) (detP⇒ d d')
-}
detP⇒ (β _) (β _)                                              = ≡.refl
detP⇒ (β _) (cong (appl u) (appl .u) (cong () _ _))
detP⇒ (cong (appl u) (appl .u) (cong () _ _)) (β _)
detP⇒ (cong (appl u) (appl .u) x) (cong (appl .u) (appl .u) y) = ≡.cong (λ t → app t u) (detP⇒ x y)

-- Neutrals are closed under application.

pneApp : ∀{Γ a b}{P : ∀{c} → Tm Γ c → Set}{t : Tm Γ (a →̂ b)}{u : Tm Γ a} →
  PNe P t → P u → PNe P (app t u)
pneApp 𝒏 𝒖 = elim 𝒏 (appl 𝒖)

-- Functoriality of the notions wrt. P.

mapPCxt : ∀ {Γ} {P Q : ∀{c} → Tm Γ c → Set} (P⊆Q : ∀ {c}{t : Tm Γ c} → P t → Q t) {a b} {E : ECxt Γ a b}{Et t} → PCxt P Et E t -> PCxt Q Et E t
mapPCxt P⊆Q (appl u∈P) = appl (P⊆Q u∈P)

mapPNe : ∀ {Γ} {P Q : ∀{c} → Tm Γ c → Set} (P⊆Q : ∀ {c}{t : Tm Γ c} → P t → Q t) {a}{t : Tm Γ a} → PNe P t -> PNe Q t
mapPNe P⊆Q (var x) = var x
mapPNe P⊆Q (elim t∈Ne E∈SNh) = elim (mapPNe P⊆Q t∈Ne) (mapPCxt P⊆Q E∈SNh)

mapP⇒ : ∀ {Γ} {P Q : ∀{c} → Tm Γ c → Set} (P⊆Q : ∀ {c}{t : Tm Γ c} → P t → Q t) {a}{t t' : Tm Γ a} → P / t ⇒ t' → Q / t ⇒ t'
mapP⇒ P⊆Q (β t∈P) = β (P⊆Q t∈P)
mapP⇒ P⊆Q (cong Et Et' t→t') = cong Et Et' (mapP⇒ P⊆Q t→t')

_[_]⇒ : ∀ {Γ} {P : ∀{c} → Tm Γ c → Set} {a b} (E : ECxt Γ a b) {t₁ t₂ : Tm Γ a} → P / t₁ ⇒ t₂ → P / E [ t₁ ] ⇒ E [ t₂ ]
E [ t⇒ ]⇒ = cong (proj₂ (mkEHole E)) (proj₂ (mkEHole E)) t⇒

_[_]⇒* : ∀ {Γ} {P : ∀{c} → Tm Γ c → Set} {a b} (E : ECxt* Γ a b) {t₁ t₂ : Tm Γ a} → P / t₁ ⇒ t₂ → P / E [ t₁ ]* ⇒ E [ t₂ ]*
[]       [ t⇒ ]⇒* = t⇒
(E ∷ Es) [ t⇒ ]⇒* = Es [ E [ t⇒ ]⇒ ]⇒*

hole→≡ : ∀ {Γ a b}{Et t}{E : ECxt Γ a b} → (Es : Ehole Et E t) → Et ≡ E [ t ]
hole→≡ (appl u) = ≡.refl

lemma : ∀ {Γ b} {a} {t : Tm Γ a} (Es : ECxt* Γ a b)
         {b₁} {E : ECxt Γ b b₁}
         → E [ Es [ t ]* ] ≡ (Es ++* (E ∷ [])) [ t ]*
lemma [] = ≡.refl
lemma (x ∷ Es) = lemma Es

hole*→≡ : ∀ {Γ a b}{Et t}{E : ECxt* Γ a b} → (Es : Ehole* Et E t) → Et ≡ E [ t ]*
hole*→≡ [] = ≡.refl
hole*→≡ {t = t} (_∷_ {Es = Es} x Es₁) rewrite hole→≡ x | hole*→≡ Es₁ = lemma Es

++*-unit : ∀ {Γ a b} → (xs : ECxt* Γ a b) → xs ++* [] ≡ xs
++*-unit [] = ≡.refl
++*-unit (x ∷ xs) = ≡.cong (_∷_ x) (++*-unit xs)
++*-assoc : ∀ {Γ a b c d} → (xs : ECxt* Γ a b) → {ys : ECxt* Γ b c} → {zs : ECxt* Γ c d} → xs ++* (ys ++* zs) ≡ (xs ++* ys) ++* zs
++*-assoc [] = ≡.refl
++*-assoc (x ∷ xs) = ≡.cong (_∷_ x) (++*-assoc xs)

_++h*_ : ∀ {Γ a b c} {Es1 : ECxt* Γ a b} {Es2 : ECxt* Γ b c} → ∀ {t1 t2 t3} → Ehole* t2 Es1 t3 → Ehole* t1 Es2 t2  → Ehole* t1 (Es1 ++* Es2) t3
_++h*_ {Es1 = Es1} xs [] rewrite ++*-unit Es1      = xs
_++h*_ {Es1 = Es1} xs (_∷_ {E = E} {Es = Es} x ys) rewrite ++*-assoc Es1 {Es} {E ∷ []} = x ∷ (xs ++h* ys)

mkEhole* : ∀ {Γ} {a b} (E : ECxt* Γ a b) {t} → Ehole* (E [ t ]*) E t
mkEhole* [] = []
mkEhole* (E ∷ Es) {t} = (proj₂ (mkEHole E) ∷ []) ++h* mkEhole* Es


{-# OPTIONS --cubical --safe #-}
module Cubical.Relation.Everything where

open import Cubical.Relation.Nullary public
open import Cubical.Relation.Nullary.DecidableEq public
open import Cubical.Relation.Binary public


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

data Irr (A : Set) : Set where
  irr : .(x : A) → Irr A

data D {A : Set} : Irr A → Set where
  -- x is mistakenly marked as forced here!
  d : (x : A) → D (irr x)

unD : ∀ {A i} → D i → A
unD (d x) = x

dtrue=dfalse : d true ≡ d false
dtrue=dfalse = refl

_$≡_ : ∀ {A B : Set} (f : A → B) {x y} → x ≡ y → f x ≡ f y
f $≡ refl = refl

true=false : true ≡ false
true=false = unD $≡ dtrue=dfalse

data ⊥ : Set where

loop : ⊥
loop with true=false
... | ()


module Issue4267.M where

record R : Set₂ where
  field
    f : Set₁


open import MJ.Types
import MJ.Classtable.Core as Core

module MJ.Syntax.Typed {c}(Ct : Core.Classtable c) where

open import Prelude
open import Data.Maybe as Maybe using (Maybe; just; nothing)
open import Data.Vec as Vec
open import Data.Star as Star
open import Data.List hiding (null)
open import Data.List.Relation.Unary.All
open import Data.List.Membership.Propositional
open import Data.List.Properties.Extra as List+
open import Relation.Binary.PropositionalEquality
open import Relation.Nullary.Decidable
open import Data.String

open Core c
open Classtable Ct
open import MJ.Classtable.Membership Ct
open import MJ.LexicalScope c

NativeBinOp = ℕ → ℕ → ℕ

{-
Expressions are indexed by a lexical context and a type.

MJ has n-ary calls for which we use All to express that an expression (of the
right type) is expected for every formal argument of the method signature.

In this nameless representation AccMember type is used to identify accessible
fields and methods on a particular class.
Here we exploit that AccMember is defined via a decision procedure: Agda
will be able to infer the membership proofs if they exist.
-}
data Expr (Γ : Ctx) : Ty c → Set where
  -- irreducible expressions
  unit     : Expr Γ void
  null     : ∀ {C} → Expr Γ (ref C)
  num      : ℕ → Expr Γ int

  -- storeless expressions
  var      : ∀ {a} → Var Γ a → Expr Γ a
  iop      : NativeBinOp → (l r : Expr Γ int) → Expr Γ int
  upcast   : ∀ {c c'} → Σ ⊢ c <: c' → Expr Γ (ref c) → Expr Γ (ref c')

  -- storeful
  new      : ∀ C → All (Expr Γ) (Class.constr (Σ C)) → Expr Γ (ref C)
  call     : ∀ {cid} →
             Expr Γ (ref cid) → ∀ m {as}{b}{acc : AccMember cid METHOD m (as , b)} → All (Expr Γ) as →
             Expr Γ b
  get      : ∀ {cid} → Expr Γ (ref cid) → ∀ f {ty}{acc : AccMember cid FIELD f ty} → Expr Γ ty

mutual
  {-
  Like Java, MJ distinguishes expressions from statements.
  We index the well-typed statement type Stmt
  with both an input and output context to capture that the constructor
  for declaration of locals loc adds to the lexical environment.
  We can interpret the type Stmt as a binary relation on contexts of which we
  can take the reflexive, transitive closure (Star)
  to obtain a datatype for sequenced statements:

  The type r represent the (possibly early) return type of a block of statements.
  -}
  infixl 20 if_then_else_
  data Stmt (I : Ctx)(r : Ty c) : (O : Ctx) → Set where
    loc        : ∀ a → Stmt I r (I +local a)
    asgn       : ∀ {a} → Var I a → Expr I a → Stmt I r I
    set        : ∀ {C} → Expr I (ref C) → ∀ f {a}{acc : AccMember C FIELD f a} → Expr I a → Stmt I r I
    run        : ∀ {a} → Expr I a → Stmt I r I
    ret        : Expr I r → Stmt I r I
    raise      : Stmt I r I
    try_catch_ : ∀ {O O'} → Stmt I r O → Stmt I r O' → Stmt I r I
    while_run_ : ∀ {O} → Expr I int → Stmt I r O → Stmt I r I
    block      : ∀ {O} → Stmts I r O → Stmt I r I
    if_then_else_ : ∀ {a} → Expr I int → Stmt I r a → Stmt I r a → Stmt I r a

  Stmts : Ctx → Ty c → Ctx → Set
  Stmts I r O = Star (λ I' O' → Stmt I' r O') I O


module Issue2641.Import where

open import Agda.Builtin.Nat

five : Nat
five = 5


------------------------------------------------------------------------
-- Example: Left recursive expression grammar
------------------------------------------------------------------------

module TotalParserCombinators.Recogniser.Expression where

open import Codata.Musical.Notation
open import Data.Bool
open import Data.Char as Char using (Char)
open import Data.List
open import Data.String as String using (String)
open import Function
open import Relation.Binary.PropositionalEquality

open import TotalParserCombinators.BreadthFirst
import TotalParserCombinators.Lib as Lib
open import TotalParserCombinators.Recogniser

------------------------------------------------------------------------
-- Lifted versions of some parsers

-- Specific tokens.

tok : Char → P Char []
tok c = lift $ Lib.Token.tok Char Char._≟_ c

-- Numbers.

number : P Char []
number = lift Lib.number

------------------------------------------------------------------------
-- An expression grammar

-- t ∷= t '+' f ∣ f
-- f ∷= f '*' a ∣ a
-- a ∷= '(' t ')' ∣ n

mutual

  term   = ♯ term · tok '+' · factor
         ∣ factor

  factor = ♯ factor · tok '*' · atom
         ∣ atom

  atom   = tok '(' · ♯ term · tok ')'
         ∣ number

------------------------------------------------------------------------
-- Unit tests

module Tests where

  test : ∀ {n} → P Char n → String → Bool
  test p s = not $ null $ parse ⟦ p ⟧ (String.toList s)

  ex₁ : test term "1*(2+3)" ≡ true
  ex₁ = refl

  ex₂ : test term "1*(2+3" ≡ false
  ex₂ = refl


{- 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
-}

open import Util.Prelude
------------------------------------------------------------------------------
open import Agda.Builtin.Float

module LibraBFT.Impl.OBM.Rust.RustTypes where

-- TODO-2 : reasoning about integer overflow

F64 : Set
F64 = Float -- This is 'Double' in Haskell.  In Agda, 'Float' is represented as a Haskell 'Double'.

U64 : Set
U64 = ℕ

U128 : Set
U128 = ℕ

Usize : Set
Usize = ℕ

postulate -- TODO-1: VecDeque, vdNew
  VecDeque : Set
  vdNew : VecDeque


-- Reported and fixed by Andrea Vezzosi.

module Issue902 where

module M (A : Set) where

postulate
  A : Set
  F : Set -> Set

test : A
test = {! let module m = M (F A) in ? !}
-- C-c C-r gives  let module m = M F A in ?
--    instead of  let module m = M (F A) in ?


-- Display whether or not the timeout was hit when using auto -l.
module Issue945 where

data ⊥ : Set where

¬_ : Set → Set
¬ A = A → ⊥

record ∃ {A : Set} (P : A → Set) : Set where
  constructor _,_
  field witness : A
        proof   : P witness

-- Exhaustive
lem₁ : ∀ {A : Set} (P : A → Set) (x : A) → (∀ x → ¬ P x) → (∀ x → P x) → ⊥
lem₁ A = {!-l -t 1!}

-- Timeout
lem₂ : ∀ {A} (P : A → Set) (x : A) → (∀ x → ¬ P x) → (∀ x → P x) → ∃ P → ⊥
lem₂ P a e = {!-l -t 1!}


{- trying (and failing) to create a univesal "successor" -}
-- types with and without payloads defined dependently, those w/o payloads in terms of those with (using ⊤ as a trivial payload)
-- this complicates the successor constructor, `!`, so we use use pattern (OR function?), `¡`
module Oscar.Data3 where

record ⊤ : Set where
  constructor tt

infixr 20 _∷_

-- List
data ⟦_⟧ {a} (A : Set a) : Set a where
  ∅ : ⟦ A ⟧
  _∷_ : A → ⟦ A ⟧ → ⟦ A ⟧

-- Nat
⟦⟧ = ⟦ ⊤ ⟧

infix 21 ¡_
pattern ¡_ ⟦A⟧ = tt ∷ ⟦A⟧
--¡ : ⟦⟧ → ⟦⟧
--¡ ⟦A⟧ = tt ∷ ⟦A⟧

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

data ⟦_⟧[_₀] {a} (A : ⟦⟧ → Set a) : ⟦⟧ → Set a where
  ∅ : ⟦ A ⟧[ ∅ ₀]
  _∷_ : ∀ {n} → A n → ⟦ A ⟧[ n ₀] → ⟦ A ⟧[ ¡ n ₀]

Const_ : ∀ {a} {A : Set a} {b} {B : Set b} → B → A → B
Const_ x _ = x

⟦⟧[_₀] = ⟦ Const ⊤ ⟧[_₀]

-- Fin
⟦⟧[_] = ⟦ 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 ]

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

testNat : ⟦⟧
testNat = ¡ ∅

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

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

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

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

-- 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 ⊤ ⟧[_↓≤↓_]

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

data D : ⟦⟧ → ⟦⟧ → Set where
  List : D ⓪ ⓪
  Fin : D ⑴ ⑴
  Vec : D ⑴ ⑴
  Descend : D ⑴ ⑵
  Ascend : D ⑴ ⑵
  Inj : D ⑵ ⑵

open import Oscar.Level
theA : ∀ ℓ → ⟦⟧ → Set (lsuc ℓ)
theA ℓ ∅ = Set ℓ
theA ℓ (tt ∷ x₁) = ⟦⟧ → theA ℓ x₁

theIndices : ⟦⟧ → Set
theIndices x = ⟦ Const ⟦⟧ ⟧[ x ₀]

μ : ∀ {p i} → D p i → ∀ {a} → theA a p → theIndices i → Set a
μ List A _ = ⟦ A ⟧
μ Fin A (n ∷ _) = ⟦ A ⟧[ n ]
μ Vec A (n ∷ _) = ⟦ A ⟧[ n ₀]
μ Descend A (m ∷ n ∷ _) = ⟦ A ⟧[ m ≤↓ n ]
μ Ascend A (m ∷ n ∷ _) = ⟦ A ⟧[ m ↑≤ n ]
μ Inj A (m ∷ n ∷ ∅) = ⟦ A ⟧[ m ↓≤↓ n ]

μ¡ : ∀ {p i} → D p i → theIndices i → Set
μ¡ List _ = ⟦⟧ → ⟦⟧
μ¡ Fin (n ∷ _) = ⟦⟧[ n ] → ⟦⟧[ ¡ n ]
μ¡ Vec (n ∷ _) = ⟦⟧[ n ₀] → ⟦⟧[ ¡ n ₀]
μ¡ Descend (m ∷ n ∷ _) = ⟦⟧[ m ≤↓ n ] → ⟦⟧[ m ≤↓ ¡ n ]
μ¡ Ascend (m ∷ n ∷ _) = ⟦⟧[ ¡ m ↑≤ n ] → ⟦⟧[ m ↑≤ n ]
μ¡ Inj (m ∷ n ∷ _) = ⟦⟧[ m ↓≤↓ n ] → ⟦⟧[ ¡ m ↓≤↓ ¡ n ]

μ¡↑ : ∀ {p i} → D p i → Set
μ¡↑ List = ⟦⟧ → ⟦⟧
μ¡↑ Fin = {!!}
μ¡↑ Vec = {!!}
μ¡↑ Descend = {!!}
μ¡↑ Ascend = {!!}
μ¡↑ Inj = {!!}

theArguments : ∀ {p i} → (d : D p i) → Set
theArguments List = μ¡ List ∅
theArguments Fin = {n : ⟦⟧} → μ¡ Fin (n ∷ ∅)
theArguments Vec = {n : ⟦⟧} → μ¡ Vec (n ∷ ∅)
theArguments Descend = {m : ⟦⟧} → {n : ⟦⟧} → μ¡ Descend (m ∷ n ∷ ∅)
theArguments Ascend = {m : ⟦⟧} → {n : ⟦⟧} → μ¡ Ascend (m ∷ n ∷ ∅)
theArguments Inj = {m : ⟦⟧} → {n : ⟦⟧} → μ¡ Inj (m ∷ n ∷ ∅)

infix 21 ↑_
↑_ : ∀ {p i} → {d : D p i} → {I : theIndices i} → μ¡ d I
↑_ {d = List} = ‼_
↑_ {d = Fin} {x ∷ I} = ‼_
↑_ {d = Vec} {x ∷ I} = ‼_
↑_ {d = Descend} {x ∷ x₁ ∷ I} = ‼_
↑_ {d = Ascend} {x ∷ x₁ ∷ I} = tt ∷_
↑_ {d = Inj} {x ∷ x₁ ∷ I} = tt ∷_

↑↑ : ∀ {p i} → {d : D p i} → theArguments d
↑↑ {d = List} = {!‼_!}
↑↑ {d = Fin} = ‼_
↑↑ {d = Vec} = ‼_
↑↑ {d = Descend} = ‼_
↑↑ {d = Ascend} = tt ∷_
↑↑ {d = Inj} = tt ∷_

record BANG {p i} (d : D p i) : Set where
  field
    ⟰ : theArguments d

open BANG ⦃ … ⦄

instance BANGFin : BANG Fin
BANG.⟰ BANGFin {n} = ‼_

testμ : μ Fin (Const ⊤) (‼ ‼ ‼ ‼ ∅ ∷ ∅)
testμ = ⟰ {d = Fin} {!!}  -- ↑↑ {d = Fin} {!!}
-- ↑_ {d = Fin} {I = _ ∷ {!!}} ∅
-- ↑_ {d = Fin} {I = {!!} ∷ {!!}} {!!}
{-
data ⟦_⟧ {a} (A : Set a) : Set a where
data ⟦_⟧[_] {a} (A : ⟦⟧ → Set a) : ⟦⟧ → Set a where
data ⟦_⟧[_≤↓_] {a} (A : ⟦⟧ → Set a) (m : ⟦⟧) : ⟦⟧ → Set a where
data ⟦_⟧[_↑≤_] {a} (A : ⟦⟧ → Set a) (m : ⟦⟧) : ⟦⟧ → Set a where
data ⟦_⟧[_↓≤↓_] {a} (A : ⟦⟧ → ⟦⟧ → Set a) : ⟦⟧ → ⟦⟧ → Set a where
-}