{-# OPTIONS --no-postfix-projections #-}

module Inception.Sub.CompMachine (R : Set) where

open import Data.Product using (proj₁; proj₂; _,_; <_,_>; curry; _×_; Σ; ; Σ-syntax; ∃-syntax)
open import Data.Sum using (_⊎_; inj₁; inj₂)
open import Function.Base using (_∘_; _$_)

import Relation.Binary.PropositionalEquality as Eq
open Eq using (_≡_; refl; cong; cong₂; sym; trans; subst; subst₂)
open Eq.≡-Reasoning using (step-≡-⟩; step-≡-∣; step-≡-⟨; _∎; step-≡)

open import Relation.Binary.Reasoning.Syntax

open import Inception.Sub.Syntax
open import Inception.Sub.CPS R

open import Data.Unit
open import Data.Nat
open import Data.List using (List; _∷_; []; _++_)

open import Inception.Sub.ValueMachine R

module CMain {R₀ : Ty} (k₀ :  R₀   R) where

  open VMain {R₀ = R₀} k₀

  data CompState : Set where

        ∘⟨_⊰_╎_⟩ : (W : Γ ⊢ᶜ X)  (γ : Env Γ)  (cs : CompStack Δ X)  {π : Wk Γ Δ}  {wk≡ :  π ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ}  CompState

        ∙⟨_⊰_╎_⟩ : (W : C̲o̲m̲p Γ X)  (γ : Env Γ)  (cs : CompStack Δ X)  {π : Wk Γ Δ}  {wk≡ :  π ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ}  CompState

  data CompHaltingState : CompState  Set where

      ret : {M : V̲a̲l̲ Γ R₀}  {γ : Env Γ}  CompHaltingState ((∙⟨ r̲e̲t̲u̲r̲n̲ M  γ   ) {π = wk-wk-ε} {wk≡ = refl} )


  infixr 15 _→ᶜ⟨_⟩_
  infixr 15 _→ᶜ*_
  infixr 10 _⨾ᶜ_

  ⟦_⟧ᶜꟴ : CompState  R
   ∘⟨ W  γ  cs  ⟧ᶜꟴ =  W ⟧ᶜ  γ ⟧ᴱ  cs ⟧ᴷ
   ∙⟨ W  γ  cs  ⟧ᶜꟴ =  toComp W ⟧ᶜ  γ ⟧ᴱ  cs ⟧ᴷ

  -- Computation Machine
  --------------------------------------------------

  infix  15 _→ᶜ_
  data _→ᶜ*_ : CompState  CompState  Set
  data _→ᶜ_ : CompState  CompState  Set

  data _→ᶜ_  where

        ∘return  :    {M : Γ ⊢ᵛ X}  {γ : Env Γ'}  {π : Wk Γ' Γ}  {M' : V̲a̲l̲ Γ'' X}  {γ' : Env Γ''}
                       {cs : CompStack Δ X}  {πₓ : Wk Γ' Δ}  {πₓ' : Wk Γ'' Δ}
                       {wk≡ₓ :  πₓ ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ}  {wk≡ₓ' :  πₓ' ⟧ʷ  γ' ⟧ᴱ   topCsEnv cs ⟧ᴱ}
                       (( (( wk-val π M  γ  ) { = 🗆})) ↠ᵛ ( (( M'  γ'  ) { = 🗆})))
                     ----------------------------------------------------------------
                           ((∘⟨ wk-comp π (return M)  γ  cs ) {π = πₓ} {wk≡ = wk≡ₓ} )
                         →ᶜ ((∙⟨ r̲e̲t̲u̲r̲n̲ M'  γ'  cs ) {π = πₓ'} {wk≡ = wk≡ₓ'})

        ∙return  :    {M : V̲a̲l̲ Γ X}  {γ : Env Γ}  {N : (Γ'  X) ⊢ᶜ Y}  {γ' : Env Γ'}  {π : Wk Γ Γ'}
                       {cs : CompStack Δ Y}  {πₓ : Wk Γ Δ}  {πₓ' : Wk Γ' Δ}
                       {wk≡ₓ :  π ⟧ʷ  γ ⟧ᴱ   γ' ⟧ᴱ}  {wk≡ₓ' :  πₓ ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ}  {wk≡ :  πₓ' ⟧ʷ  γ' ⟧ᴱ   topCsEnv cs ⟧ᴱ }
                  ----------------------------------------------------------------
                           ((∙⟨ r̲e̲t̲u̲r̲n̲ M  γ  ((N  γ' ⦂⦂ cs) {π = πₓ'} {wk≡ = wk≡}) ) {π = π} {wk≡ = wk≡ₓ})
                         →ᶜ ((∘⟨ wk-comp (wk-cong π) N  γ  M  cs ) {π = wk-wk πₓ} {wk≡ = wk≡ₓ'})

        ∘push    :    {M : Γ ⊢ᶜ X}  {N : (Γ  X) ⊢ᶜ Y}  {γ : Env Γ}
                     {cs : CompStack Δ Y}  {πₓ : Wk Γ Δ}
                     {wk≡ₓ :  πₓ ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ}  {wk≡ :  πₓ ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ}
                  ----------------------------------------------------------------
                           ((∘⟨ push M N  γ  cs ) {π = πₓ} {wk≡ = wk≡ₓ})

                        →ᶜ ((∘⟨ M  γ  ((N  γ ⦂⦂ cs) {π = πₓ}  {wk≡ = wk≡}) ) {π = wk-id} {wk≡ = refl})

        ∘sub     :    {M : (Γ  `V) ⊢ᶜ X}  {N : Γ ⊢ᶜ X}  {γ : Env Γ}
                     {cs : CompStack Δ X}  {πₓ : Wk Γ Δ}  {wk≡ₓ :  πₓ ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ}
                  ----------------------------------------------------------------
                           ((∘⟨ sub M N  γ  cs ) {π = πₓ} {wk≡ = wk≡ₓ})
                         →ᶜ ((∘⟨ M  ((γ ﹐﹝ N  cs ) {π = πₓ} {wk≡ = wk≡ₓ})  cs ) {π = wk-wk πₓ} {wk≡ = wk≡ₓ})

        ∘pm      :    {M : Γ' ⊢ᵛ X  Y}  {γ : Env Γ}  {W : (Γ'  X  Y) ⊢ᶜ Z}
                     {cs : CompStack Δ Z}  {πₓ : Wk Γ Δ}  {πₓ' : Wk Γ'' Δ}  {γ'' : Env Γ''}
                     {wk≡ₓ :  πₓ ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ}  {wk≡ₓ' :  πₓ' ⟧ʷ  γ'' ⟧ᴱ   topCsEnv cs ⟧ᴱ}
                     {LHS : V̲a̲l̲ Γ'' X}  {RHS : V̲a̲l̲ Γ'' Y}  (π : Wk Γ Γ')
                     (( (( wk-val π M  γ  ) { = 🗆})) ↠ᵛ ( (( pa̲i̲r̲ LHS RHS  γ''  ) { = 🗆})))  (π' : Wk Γ'' Γ)
                  ----------------------------------------------------------------
                           ((∘⟨ pm (wk-val π M) (wk-comp (wk-cong (wk-cong π)) W)  γ  cs ) {π = πₓ} {wk≡ = wk≡ₓ})
                         →ᶜ ((∘⟨ wk-comp (wk-cong (wk-cong π')) (wk-comp (wk-cong (wk-cong π)) W)  γ''  LHS  wk-v̲a̲l̲ (wk-wk wk-id) RHS  cs )
                               {π = wk-wk (wk-wk πₓ')}  {wk≡ = wk≡ₓ'})

        ∙app-var   :     {i : Γ  (Z' `⇒ Z)}  {N : V̲a̲l̲ Γ Z'}  {γ : Env Γ}  {cs : CompStack Δ Z}  {πₓ : Wk Γ Δ}  {wk≡ₓ :  πₓ ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ}
                        {W : (Γ'  Z') ⊢ᶜ Z}  {γ' : Env Γ'}
                        ( i  γ  →ᴸ*  h  _﹐_ γ' (l̲a̲m̲ W) )  (πᵥ : Wk Γ Γ')
                     ----------------------------------------------------------------
                           ((∙⟨ a̲pp (var i) N  γ  cs ) {π = πₓ} {wk≡ = wk≡ₓ})
                         →ᶜ ((∘⟨ (wk-comp (wk-cong πᵥ) W)  γ  N  cs ) {π = wk-wk πₓ} {wk≡ = wk≡ₓ})

        ∙app-pm     :    {M : Γ ⊢ᵛ (X  Y)}  {N₁ : (Γ  X  Y) ⊢ᵛ (Z' `⇒ Z)}  {N : V̲a̲l̲ Γ Z'}  {γ : Env Γ}
                        {cs : CompStack Δ Z}  {πₓ : Wk Γ Δ}  {πₓ' : Wk Γ' Δ}
                        {LHS : V̲a̲l̲ Γ' X}  {RHS : V̲a̲l̲ Γ' Y}  {γ' : Env Γ'}
                        {wk≡ₓ :  πₓ ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ}  {wk≡ₓ' :  πₓ' ⟧ʷ  γ' ⟧ᴱ   topCsEnv cs ⟧ᴱ}
                        (( (( M  γ  ) { = 🗆})) ↠ᵛ ( (( pa̲i̲r̲ LHS RHS  γ'  ) { = 🗆})))  (π : Wk Γ' Γ)
                     ----------------------------------------------------------------
                           ((∙⟨ a̲pp (pm M N₁) N  γ  cs ) {π = πₓ} {wk≡ = wk≡ₓ})
                         →ᶜ ((∙⟨ a̲pp ((wk-val (wk-cong (wk-cong π)) N₁)) (wk-v̲a̲l̲ (wk-wk (wk-wk π)) N)  γ'  LHS  (wk-v̲a̲l̲ (wk-wk wk-id) RHS)  cs )
                               {π = wk-wk (wk-wk πₓ')} {wk≡ = wk≡ₓ'})

        ∙app-lam     :   {W : (Γ  X) ⊢ᶜ Y}  {N : V̲a̲l̲ Γ X}  {γ : Env Γ}
                        {cs : CompStack Δ Y}  {πₓ : Wk Γ Δ}  {wk≡ₓ :  πₓ ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ}
                     ----------------------------------------------------------------
                        ((∙⟨ a̲pp (lam W) N  γ  cs ) {π = πₓ} {wk≡ = wk≡ₓ}) →ᶜ ((∘⟨ W  γ  N  cs ) {π = wk-wk πₓ} {wk≡ = wk≡ₓ})

        ∘app         :   {M : Γ ⊢ᵛ X `⇒ Y}  {N : Γ ⊢ᵛ X}  {γ : Env Γ}  {cs : CompStack Δ Y}  {πₓ : Wk Γ Δ}  {πₓ' : Wk Γ' Δ}
                        {N' : V̲a̲l̲ Γ' X}  {γ' : Env Γ'}  {wk≡ₓ :  πₓ ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ}  {wk≡ₓ' :  πₓ' ⟧ʷ  γ' ⟧ᴱ   topCsEnv cs ⟧ᴱ}
                        (( (( N  γ  ) { = 🗆})) ↠ᵛ ( (( N'  γ'  ) { = 🗆})))  (π : Wk Γ' Γ)
                     ----------------------------------------------------------------
                           ((∘⟨ app M N  γ  cs ) {π = πₓ} {wk≡ = wk≡ₓ})
                         →ᶜ ((∙⟨ a̲pp (wk-val π M) N'  γ'  cs ) {π = πₓ'} {wk≡ = wk≡ₓ'})

        ∘var         :   {M : Γ ⊢ᵛ `V}  {γ : Env Γ}  {i : Γ'  `V}  {γ' : Env Γ'}  {W : Γ'' ⊢ᶜ X'}  {γ'' : Env Γ''}
                        {cs : CompStack Δ X}  {cs' : CompStack Δ' X'}  {πₓ : Wk Γ Δ}  {πₓ'' : Wk Γ'' Δ'}
                        {wk≡ₓ :  πₓ ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ}  {wk≡ₓ'' :  πₓ'' ⟧ʷ  γ'' ⟧ᴱ   topCsEnv cs' ⟧ᴱ}
                        (( (( M  γ  ) { = 🗆})) ↠ᵛ ( (( v̲a̲r̲ i  γ'  ) { = 🗆})))  (π' : Wk Γ' Γ)
                        ( i  γ'  →ᴸ*  h  ((γ'' ﹐﹝ W  cs' ) {π = πₓ''} {wk≡ = wk≡ₓ''}) )  (πᵥ : Wk Γ' Γ'')
                  ----------------------------------------------------------------
                           ((∘⟨ var M  γ  cs ) {π = πₓ} {wk≡ = wk≡ₓ})
                         →ᶜ ((∘⟨ W  γ''  cs' ) {π = πₓ''} {wk≡ = wk≡ₓ''})

  data _→ᶜ*_ where

    _◼ : (S : CompState)  S →ᶜ* S

    _→ᶜ⟨_⟩_ : (S : CompState)  {S' S'' : CompState}  S →ᶜ S'  S' →ᶜ* S''  S →ᶜ* S''

  _⨾ᶜ_ : {F S T : CompState}  (F →ᶜ* S)  (S →ᶜ* T)  (F →ᶜ* T)
  _⨾ᶜ_ (S ) S>>T = S>>T
  _⨾ᶜ_ (F →ᶜ⟨ F>S₁  S₁>>S₂) S₂>>T = F →ᶜ⟨ F>S₁  (S₁>>S₂ ⨾ᶜ S₂>>T)

  topCompCtx : CompState  Ctx
  topCompCtx (∘⟨_⊰_╎_⟩ {Γ = Γ} _ _ _) = Γ
  topCompCtx (∙⟨_⊰_╎_⟩ {Γ = Γ} _ _ _) = Γ

  topCompEnv : (Q : CompState)  Env (topCompCtx Q)
  topCompEnv (∘⟨_⊰_╎_⟩ _ γ _) = γ
  topCompEnv (∙⟨_⊰_╎_⟩ _ γ _) = γ

  data CompSteps : CompState  Set where

      steps : {S T : CompState}  S →ᶜ* T  CompHaltingState T   S ⟧ᶜꟴ   T ⟧ᶜꟴ  CompSteps S


  lem0 : (cs : CompStack Δ X)  (MM : K  X )   cs ⟧ᶜˢ  k  MM k) k₀  MM  y   cs ⟧ᶜˢ  k  k y) k₀)
  lem0  MM = refl
  lem0 {X = X} ((W  γ ⦂⦂ cs) {π = π} {wk≡ = wk≡}) MM =            (W  γ ⦂⦂ cs) {π = π} {wk≡ = wk≡} ⟧ᶜˢ MM k₀
                                   ≡⟨ refl 
                                      cs ⟧ᶜˢ  k   x  MM  z   W ⟧ᶜ ( γ ⟧ᴱ , z) x)) k) k₀
                                   ≡⟨ lem0 cs  x  MM  z   W ⟧ᶜ ( γ ⟧ᴱ , z) x)) 
                                      x  MM  z   W ⟧ᶜ ( γ ⟧ᴱ , z) x))  y   cs ⟧ᶜˢ  k  k y) k₀)
                                   ≡⟨ refl 
                                     MM  z         W ⟧ᶜ ( γ ⟧ᴱ , z)  y   cs ⟧ᶜˢ  k  k y) k₀)            )
                                   ≡⟨ cong MM lem0'' 
                                     MM  z         cs ⟧ᶜˢ  k   W ⟧ᶜ ( γ ⟧ᴱ , z) k) k₀                      )
                                   ≡⟨ refl 
                                     MM  y   (W  γ ⦂⦂ cs) {π = π} {wk≡ = wk≡} ⟧ᶜˢ  k  k y) k₀) 

                                   where
                                      lem0' : (z :  X )   W ⟧ᶜ ( γ ⟧ᴱ , z)  y   cs ⟧ᶜˢ  k  k y) k₀)   cs ⟧ᶜˢ  k   W ⟧ᶜ ( γ ⟧ᴱ , z) k) k₀
                                      lem0' z = sym (lem0 cs ( W ⟧ᶜ ( γ ⟧ᴱ , z)))

                                      lem0'' :  z   W ⟧ᶜ ( γ ⟧ᴱ , z)  y   cs ⟧ᶜˢ  k  k y) k₀))   z   cs ⟧ᶜˢ  k   W ⟧ᶜ ( γ ⟧ᴱ , z) k) k₀)
                                      lem0'' = extensionality lem0'

  wk-v̲a̲l̲-id : (M : V̲a̲l̲ Γ X)  wk-v̲a̲l̲ wk-id M  M
  wk-v̲a̲l̲-id (l̲a̲m̲ M) = cong l̲a̲m̲ (wk-comp-id M)
  wk-v̲a̲l̲-id (pa̲i̲r̲ LHS RHS) = cong₂ pa̲i̲r̲ (wk-v̲a̲l̲-id LHS) (wk-v̲a̲l̲-id RHS)
  wk-v̲a̲l̲-id u̲n̲i̲t̲ = refl
  wk-v̲a̲l̲-id (v̲a̲r̲ i) = cong v̲a̲r̲ (wk-mem-id)

  {-# REWRITE wk-v̲a̲l̲-id #-}

  wk-comm-explicit : (M : V̲a̲l̲ Γ X)  (π : Wk Δ Γ)  toVal (wk-v̲a̲l̲ π M)  wk-val π (toVal M)
  wk-comm-explicit M π = sym wk-comm

  {-# REWRITE wk-comm-explicit #-}

  -------------------------------------------------------------------------------------------------

  {-# TERMINATING #-}
  mutual

    app-eval-rec :   (M : Γ' ⊢ᵛ X `⇒ Y)  (N : V̲a̲l̲ Γ X)  (γ : Env Γ)  (π : Wk Γ Γ')  (cs : CompStack Δ Y)  (πₓ : Wk Γ Δ)
                    (wk≡₀ :  πₓ ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ)
                    CompSteps ((∙⟨ (a̲pp (wk-val π M) N)  γ  cs ) {π = πₓ} {wk≡ = wk≡₀})

    app-eval-rec (var i) N γ π cs πₓ wk≡₀ with lookup (wk-mem π i) γ
    ... | steps i>>T (found-lam {X = X} {W = W} {γ = γ₁}) i≡T π₁ w≡γ with comp-eval-rec W (γ  N) (wk-cong π₁) cs (wk-wk πₓ) wk≡₀
    ... | steps {T = T} W>WT HT S≡T =

                 steps

                    ((∙⟨ a̲pp (wk-val π (var i)) N  γ  cs  →ᶜ⟨ ∙app-var i>>T π₁  W>WT))

                    HT

                    (    ((∙⟨ C̲o̲m̲p.a̲pp (var (wk-mem π i)) N  γ  cs ) {π = πₓ} {wk≡ = wk≡₀}) ⟧ᶜꟴ
                      ≡⟨ refl 
                         wk-mem π i ⟧ᵐ  γ ⟧ᴱ ( toVal N ⟧ᵛ  γ ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)
                      ≡⟨ cong  x  x ( toVal N ⟧ᵛ  γ ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)) i≡T 
                        W ⟧ᶜ ( γ₁ ⟧ᴱ , ( toVal N ⟧ᵛ  γ ⟧ᴱ))   y   cs ⟧ᶜˢ  k  k y) k₀)
                      ≡⟨ cong  x   W ⟧ᶜ (x , ( toVal N ⟧ᵛ  γ ⟧ᴱ))   y   cs ⟧ᶜˢ  k  k y) k₀)) (sym w≡γ) 
                        W ⟧ᶜ ( π₁ ⟧ʷ  γ ⟧ᴱ ,  toVal N ⟧ᵛ  γ ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)
                      ≡⟨ refl 
                         ((∘⟨ wk-comp (wk-cong π₁) W  γ Env.﹐ N  cs ) {π = wk-wk πₓ} {wk≡ = wk≡₀}) ⟧ᶜꟴ
                      ≡⟨ S≡T 
                         T ⟧ᶜꟴ )


    app-eval-rec (lam W) N γ π cs πₓ wk≡₀ with comp-eval-rec W (γ  N) (wk-cong π) cs (wk-wk πₓ) wk≡₀
    ... | steps {T = T} W>WT HT S≡T =

                  steps

                     ( ∙⟨ a̲pp (wk-val π (lam W)) N  γ  cs  →ᶜ⟨ ∙app-lam  W>WT)

                     HT

                     S≡T

    app-eval-rec (pm M₁ N₁) N γ π cs πₓ wk≡₀ with val-eval-rec M₁ γ π
    ... | steps {T =  ( pa̲i̲r̲ {X = X} {Y = Y} LHS RHS  γ₁  ) { = 🗆}} M>T ∙T M≡T π' wk≡ with wk-val-trans N₁ (wk-cong (wk-cong π')) (wk-cong (wk-cong π))
    ...       | eq with
                    app-eval-rec
                      N₁
                      ((wk-v̲a̲l̲ (wk-wk (wk-wk π')) N))
                      (γ₁  LHS  wk-v̲a̲l̲ (wk-wk wk-id) RHS)
                      (wk-cong (wk-cong (wk-trans π' π)))
                      cs
                      (wk-wk (wk-wk (wk-trans π' πₓ)))
                      ( wk-wk (wk-wk (wk-trans π' πₓ)) ⟧ʷ  γ₁  LHS  wk-v̲a̲l̲ (wk-wk wk-id) RHS ⟧ᴱ
                       ≡⟨ refl   wk-trans π' πₓ ⟧ʷ  γ₁ ⟧ᴱ ≡⟨ sym (wk-sem-trans π' πₓ  γ₁ ⟧ᴱ)   πₓ ⟧ʷ ( π' ⟧ʷ  γ₁ ⟧ᴱ)
                       ≡⟨ cong  πₓ ⟧ʷ wk≡   πₓ ⟧ʷ  γ ⟧ᴱ
                       ≡⟨ wk≡₀   topCsEnv cs ⟧ᴱ )
    ...          | steps {T = T} N>NT NT S≡T rewrite (sym eq) =

                 steps

                    (∙⟨ (a̲pp (wk-val π (pm M₁ N₁)) N)  γ  cs  →ᶜ⟨ ∙app-pm M>T π'  N>NT )

                    NT

                    ( N₁ ⟧ᵛ (( π ⟧ʷ  γ ⟧ᴱ , proj₁ ( M₁ ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ))) , proj₂ ( M₁ ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ))) ( toVal N ⟧ᵛ  γ ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)
                      ≡⟨ cong  x   N₁ ⟧ᵛ (( π ⟧ʷ  γ ⟧ᴱ , proj₁ x) , proj₂ x) ( toVal N ⟧ᵛ  γ ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)) M≡T 
                      N₁ ⟧ᵛ (( π ⟧ʷ  γ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ) ,  toVal RHS ⟧ᵛ  γ₁ ⟧ᴱ) ( toVal N ⟧ᵛ  γ ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)
                      ≡⟨ cong  x   N₁ ⟧ᵛ (( π ⟧ʷ  γ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ) ,  toVal RHS ⟧ᵛ  γ₁ ⟧ᴱ) ( toVal N ⟧ᵛ x)  y   cs ⟧ᶜˢ  k  k y) k₀)) (sym wk≡) 
                      N₁ ⟧ᵛ (( π ⟧ʷ  γ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ) ,  toVal (wk-v̲a̲l̲ wk-id RHS) ⟧ᵛ  γ₁ ⟧ᴱ) ( toVal N ⟧ᵛ ( π' ⟧ʷ  γ₁ ⟧ᴱ))  y   cs ⟧ᶜˢ  k  k y) k₀)
                      ≡⟨ refl 
                      N₁ ⟧ᵛ ((  π ⟧ʷ  γ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ) ,
                                toVal (wk-v̲a̲l̲ (wk-wk wk-id) RHS) ⟧ᵛ ( γ₁ ⟧ᴱ ,
                                toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ))
                             ( toVal (wk-v̲a̲l̲ (wk-wk (wk-wk π')) N) ⟧ᵛ (( γ₁ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ) ,
                               toVal (wk-v̲a̲l̲ (wk-wk wk-id) RHS) ⟧ᵛ ( γ₁ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ)))
                              y   cs ⟧ᶜˢ  k  k y) k₀)
                      ≡⟨ cong  x   N₁ ⟧ᵛ (( π ⟧ʷ x ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ) ,
                                                toVal (wk-v̲a̲l̲ (wk-wk wk-id) RHS) ⟧ᵛ ( γ₁ ⟧ᴱ ,
                                                toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ)) ( toVal (wk-v̲a̲l̲ (wk-wk (wk-wk π')) N) ⟧ᵛ (( γ₁ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ) ,
                                                toVal (wk-v̲a̲l̲ (wk-wk wk-id) RHS) ⟧ᵛ ( γ₁ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ)))
                                              y   cs ⟧ᶜˢ  k  k y) k₀)) (sym wk≡) 
                      N₁ ⟧ᵛ ((  π ⟧ʷ ( π' ⟧ʷ  γ₁ ⟧ᴱ) ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ) ,
                                toVal (wk-v̲a̲l̲ (wk-wk wk-id) RHS) ⟧ᵛ ( γ₁ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ))
                             (  toVal (wk-v̲a̲l̲ (wk-wk (wk-wk π')) N) ⟧ᵛ (( γ₁ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ) ,
                                toVal (wk-v̲a̲l̲ (wk-wk wk-id) RHS) ⟧ᵛ ( γ₁ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ)))  y   cs ⟧ᶜˢ  k  k y) k₀)
                      ≡⟨ cong  x   N₁ ⟧ᵛ ((x ,
                                               toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ) ,
                                               toVal (wk-v̲a̲l̲ (wk-wk wk-id) RHS) ⟧ᵛ ( γ₁ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ))
                                             ( toVal (wk-v̲a̲l̲ (wk-wk (wk-wk π')) N) ⟧ᵛ (( γ₁ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ) ,
                                               toVal (wk-v̲a̲l̲ (wk-wk wk-id) RHS) ⟧ᵛ ( γ₁ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ)))
                                              y   cs ⟧ᶜˢ  k  k y) k₀) ) (wk-sem-trans π' π  γ₁ ⟧ᴱ) 
                      N₁ ⟧ᵛ ((  wk-trans π' π ⟧ʷ  γ₁ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ) ,
                                toVal (wk-v̲a̲l̲ (wk-wk wk-id) RHS) ⟧ᵛ ( γ₁ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ))
                             (  toVal (wk-v̲a̲l̲ (wk-wk (wk-wk π')) N) ⟧ᵛ (( γ₁ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ) ,
                                toVal (wk-v̲a̲l̲ (wk-wk wk-id) RHS) ⟧ᵛ ( γ₁ ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ₁ ⟧ᴱ)))
                              y   cs ⟧ᶜˢ  k  k y) k₀)
                      ≡⟨ S≡T 
                      T ⟧ᶜꟴ )

    comp-eval-rec : (W : Γ' ⊢ᶜ X)  (γ : Env Γ)  (π : Wk Γ Γ')  (cs : CompStack Δ X)  (πₓ : Wk Γ Δ)
                   (wk≡₀ :  πₓ ⟧ʷ  γ ⟧ᴱ   topCsEnv cs ⟧ᴱ)
                   CompSteps ((∘⟨ wk-comp π W  γ  cs ) {π = πₓ} {wk≡ = wk≡₀})

    comp-eval-rec (return {A = X} M) γ π  πₓ wk≡₀ with val-eval-rec {X = X} M γ π
    ... | steps {T =  (( M₁  γ₁  ) { = 🗆})} M>T ∙T M≡T π' wk≡ =

                 steps

                    (∘⟨ wk-comp π (return M)  γ    →ᶜ⟨ ∘return M>T  (∙⟨ r̲e̲t̲u̲r̲n̲ M₁  γ₁    ))

                    ret

                    (cong  x  (η x) k₀) M≡T)

    comp-eval-rec (return {A = X} M) γ π ((M'  γ' ⦂⦂ cs) {π = π₁} {wk≡ = wk≡₁}) πₓ wk≡₀ with val-eval-rec {X = X} M γ π
    ... | steps {T =  (( M₁  γ₁  ) { = 🗆})} M>T ∙T M≡T π' wk≡ with
                 comp-eval-rec
                   M'
                   (γ₁  M₁)
                   (wk-cong (wk-trans π' πₓ))
                   cs
                   (wk-wk (wk-trans (wk-trans π' πₓ) π₁))
                   ( wk-wk (wk-trans (wk-trans π' πₓ) π₁) ⟧ʷ  γ₁  M₁ ⟧ᴱ
                    ≡⟨ refl   (wk-trans (wk-trans π' πₓ) π₁) ⟧ʷ  γ₁ ⟧ᴱ
                    ≡⟨ sym (wk-sem-trans (wk-trans π' πₓ) π₁  γ₁ ⟧ᴱ)   π₁ ⟧ʷ ( wk-trans π' πₓ ⟧ʷ  γ₁ ⟧ᴱ)
                    ≡⟨ cong  π₁ ⟧ʷ (sym (wk-sem-trans π' πₓ  γ₁ ⟧ᴱ))   π₁ ⟧ʷ ( πₓ ⟧ʷ ( π' ⟧ʷ  γ₁ ⟧ᴱ))
                    ≡⟨ cong  x   π₁ ⟧ʷ ( πₓ ⟧ʷ x)) wk≡   π₁ ⟧ʷ ( πₓ ⟧ʷ  γ ⟧ᴱ)
                    ≡⟨ cong  π₁ ⟧ʷ wk≡₀   π₁ ⟧ʷ  γ' ⟧ᴱ
                    ≡⟨ wk≡₁   topCsEnv cs ⟧ᴱ )
    ... | steps {T = ∙⟨ r̲e̲t̲u̲r̲n̲  M₂  γ₂   } M'>T ret S≡T =

                   steps

                   (∘⟨ wk-comp π (return M)  γ  (M'  γ' ⦂⦂ cs) 
                    →ᶜ⟨ ∘return {wk≡ₓ' =  wk-trans π' πₓ ⟧ʷ  γ₁ ⟧ᴱ
                                         ≡⟨ sym (wk-sem-trans π' πₓ  γ₁ ⟧ᴱ)   πₓ ⟧ʷ ( π' ⟧ʷ  γ₁ ⟧ᴱ)
                                         ≡⟨ cong  πₓ ⟧ʷ wk≡   πₓ ⟧ʷ  γ ⟧ᴱ
                                         ≡⟨ wk≡₀   γ' ⟧ᴱ } M>T  ((∙⟨ r̲e̲t̲u̲r̲n̲ M₁  γ₁  M'  γ' ⦂⦂ cs ) {wk≡ = ≡-syntax.step-≡-⟩ _≡_ trans ( wk-trans π' πₓ ⟧ʷ  γ₁ ⟧ᴱ)
                                                                                                                   (≡-syntax.step-≡-⟩ _≡_ trans ( πₓ ⟧ʷ ( π' ⟧ʷ  γ₁ ⟧ᴱ))
                                                                                                                    (≡-syntax.step-≡-⟩ _≡_ trans ( πₓ ⟧ʷ  γ ⟧ᴱ)
                                                                                                                     ((_≡_ end-syntax.∎) refl  γ' ⟧ᴱ) wk≡₀)
                                                                                                                    (cong  πₓ ⟧ʷ wk≡))
                                                                                                                   (sym (wk-sem-trans π' πₓ  γ₁ ⟧ᴱ))})
                    →ᶜ⟨ ∙return {πₓ = wk-trans (wk-trans π' πₓ) π₁} {πₓ' = π₁}  M'>T)

                   ret

                   (   (( π ⟧ʷ   M ⟧ᵛ)  η)  γ ⟧ᴱ  (M'  γ' ⦂⦂ cs) {π = π₁} {wk≡ = wk≡₁} ⟧ᴷ
                     ≡⟨ refl 
                        cs ⟧ᶜˢ  k   M' ⟧ᶜ ( γ' ⟧ᴱ ,  M ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ)) k) k₀
                     ≡⟨ lem0 cs ( M' ⟧ᶜ ( γ' ⟧ᴱ ,  M ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ))) 
                        M' ⟧ᶜ ( γ' ⟧ᴱ ,  M ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ))  y   cs ⟧ᶜˢ  k  k y) k₀)
                     ≡⟨ cong  x   M' ⟧ᶜ (x ,  M ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ))  y   cs ⟧ᶜˢ  k  k y) k₀)) (sym wk≡₀) 
                        M' ⟧ᶜ ( πₓ ⟧ʷ  γ ⟧ᴱ ,  M ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ))  y   cs ⟧ᶜˢ  k  k y) k₀)
                     ≡⟨ cong  x   M' ⟧ᶜ ( πₓ ⟧ʷ x ,  M ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ))  y   cs ⟧ᶜˢ  k  k y) k₀)) (sym wk≡) 
                        M' ⟧ᶜ ( πₓ ⟧ʷ ( π' ⟧ʷ  γ₁ ⟧ᴱ) ,  M ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ))  y   cs ⟧ᶜˢ  k  k y) k₀)
                     ≡⟨ cong  x   M' ⟧ᶜ ( πₓ ⟧ʷ ( π' ⟧ʷ  γ₁ ⟧ᴱ) , x)  y   cs ⟧ᶜˢ  k  k y) k₀)) M≡T 
                        M' ⟧ᶜ ( πₓ ⟧ʷ ( π' ⟧ʷ  γ₁ ⟧ᴱ) ,  toVal M₁ ⟧ᵛ  γ₁ ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)
                     ≡⟨ cong  x   M' ⟧ᶜ (x ,  toVal M₁ ⟧ᵛ  γ₁ ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)) (wk-sem-trans π' πₓ  γ₁ ⟧ᴱ) 
                        M' ⟧ᶜ ( wk-trans π' πₓ ⟧ʷ  γ₁ ⟧ᴱ ,  toVal M₁ ⟧ᵛ  γ₁ ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)
                     ≡⟨ refl 
                       (<  r  proj₁ r)   wk-trans π' πₓ ⟧ʷ ,  r  proj₂ r) >   M' ⟧ᶜ) ( γ₁ ⟧ᴱ ,  toVal M₁ ⟧ᵛ  γ₁ ⟧ᴱ)  cs ⟧ᴷ
                     ≡⟨ S≡T 
                       ( toVal M₂ ⟧ᵛ  η)  γ₂ ⟧ᴱ   ⟧ᴷ )

    comp-eval-rec (pm {A = X} {B = Y} M W) γ π cs πₓ wk≡₀ with val-eval-rec {X = X  Y} M γ π
    ...  | steps {T =  ((⭭_ {X = X  Y} (pa̲i̲r̲ LHS RHS)  γ'  ) { = 🗆})} M>T ∙T M≡T π' wk≡ with
                    comp-eval-rec
                     W
                     (γ'  LHS  wk-v̲a̲l̲ (wk-wk wk-id) RHS)
                     (wk-trans (wk-cong (wk-cong π')) (wk-cong (wk-cong π)))
                     cs
                     (wk-wk (wk-wk (wk-trans π' πₓ)))
                     ( wk-trans π' πₓ ⟧ʷ  γ' ⟧ᴱ
                      ≡⟨ sym (wk-sem-trans π' πₓ  γ' ⟧ᴱ)   πₓ ⟧ʷ ( π' ⟧ʷ  γ' ⟧ᴱ)
                      ≡⟨ cong  πₓ ⟧ʷ wk≡   πₓ ⟧ʷ  γ ⟧ᴱ
                      ≡⟨ wk≡₀   topCsEnv cs ⟧ᴱ )
    ...   | steps {T = T} W>T HT S≡T with wk-comp-trans W (wk-cong (wk-cong π')) (wk-cong (wk-cong π))
    ...     | eq rewrite (sym eq) =

                steps

                   (∘⟨ wk-comp π (pm M W)  γ  cs  →ᶜ⟨ ∘pm π M>T π'  W>T)

                   HT

                   (  W ⟧ᶜ (( π ⟧ʷ  γ ⟧ᴱ , proj₁ ( M ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ))) , proj₂ ( M ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ)))  y   cs ⟧ᶜˢ  k  k y) k₀)
                    ≡⟨ cong₂  x y   W ⟧ᶜ (( π ⟧ʷ x , proj₁ y) , proj₂ y)  y   cs ⟧ᶜˢ  k  k y) k₀)) (sym wk≡) M≡T 
                      W ⟧ᶜ (( π ⟧ʷ ( π' ⟧ʷ  γ' ⟧ᴱ) ,  toVal LHS ⟧ᵛ  γ' ⟧ᴱ) ,  toVal RHS ⟧ᵛ  γ' ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)
                    ≡⟨ cong  x   W ⟧ᶜ ((x ,  toVal LHS ⟧ᵛ  γ' ⟧ᴱ) ,  toVal RHS ⟧ᵛ  γ' ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)) (wk-sem-trans π' π  γ' ⟧ᴱ) 
                      W ⟧ᶜ (( wk-trans π' π ⟧ʷ  γ' ⟧ᴱ ,  toVal LHS ⟧ᵛ  γ' ⟧ᴱ) ,  toVal RHS ⟧ᵛ  γ' ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)
                    ≡⟨ S≡T 
                      T ⟧ᶜꟴ )

    comp-eval-rec (push W V) γ π cs πₓ wk≡₀ with comp-eval-rec W γ π (((wk-comp (wk-cong π) V)  γ ⦂⦂ cs) {wk≡ = wk≡₀}) wk-id refl
    ... | steps {T = ∙⟨ r̲e̲t̲u̲r̲n̲ M  γ₁   } W>T ret S≡T =

                steps

                  (  ∘⟨ push (wk-comp π W) (wk-comp (wk-cong π) V)  γ  cs   →ᶜ⟨ ∘push  W>T )

                  ret

                  (   W ⟧ᶜ ( π ⟧ʷ  γ ⟧ᴱ)  z   V ⟧ᶜ ( π ⟧ʷ  γ ⟧ᴱ , z)  y   cs ⟧ᶜˢ  k  k y) k₀))
                  ≡⟨  cong ( W ⟧ᶜ ( π ⟧ʷ  γ ⟧ᴱ)) (extensionality  z  sym (lem0 cs (( V ⟧ᶜ ( π ⟧ʷ  γ ⟧ᴱ , z)))))) 
                      W ⟧ᶜ ( π ⟧ʷ  γ ⟧ᴱ)  z   cs ⟧ᶜˢ  k   V ⟧ᶜ ( π ⟧ʷ  γ ⟧ᴱ , z) k) k₀)
                  ≡⟨ refl 
                    ( π ⟧ʷ   W ⟧ᶜ)  γ ⟧ᴱ  (wk-comp (wk-cong π) V  γ ⦂⦂ cs) {π = πₓ} {wk≡ = wk≡₀} ⟧ᴷ
                  ≡⟨ S≡T 
                    ( toVal M ⟧ᵛ  η)  γ₁ ⟧ᴱ   ⟧ᴷ )

    comp-eval-rec (app M N) γ π cs πₓ wk≡₀ with val-eval-rec N γ π
    ... | steps {T =  ((⭭_ NT  γᴺ  ) { = 🗆})} N>NT ∙NT N≡NT πᴺ wk≡ᴺ with
                    app-eval-rec
                      M
                      NT
                      γᴺ
                      (wk-trans πᴺ π)
                      cs
                      (wk-trans πᴺ πₓ)
                      ( wk-trans πᴺ πₓ ⟧ʷ  γᴺ ⟧ᴱ
                       ≡⟨ sym (wk-sem-trans πᴺ πₓ  γᴺ ⟧ᴱ)   πₓ ⟧ʷ ( πᴺ ⟧ʷ  γᴺ ⟧ᴱ)
                       ≡⟨ cong  πₓ ⟧ʷ wk≡ᴺ   πₓ ⟧ʷ  γ ⟧ᴱ
                       ≡⟨ wk≡₀   topCsEnv cs ⟧ᴱ )
    ... | steps {T = T} W>WT HT S≡T rewrite (sym (wk-val-trans M πᴺ π)) =

            steps

                ((∘⟨ app (wk-val π M) (wk-val π N)  γ  cs  →ᶜ⟨ ∘app N>NT πᴺ  W>WT ))

                HT

                ((<  π ⟧ʷ   M ⟧ᵛ ,  π ⟧ʷ   N ⟧ᵛ >  Data.Product.uncurry idf)  γ ⟧ᴱ  cs ⟧ᴷ
                ≡⟨ refl 
                  M ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ) ( N ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ))  y   cs ⟧ᶜˢ  k  k y) k₀)
                ≡⟨ cong  x   M ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ) x  y   cs ⟧ᶜˢ  k  k y) k₀)) N≡NT 
                  M ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ) ( toVal NT ⟧ᵛ  γᴺ ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)
                ≡⟨ cong  x   M ⟧ᵛ ( π ⟧ʷ x) ( toVal NT ⟧ᵛ  γᴺ ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)) (sym wk≡ᴺ) 
                  M ⟧ᵛ ( π ⟧ʷ ( πᴺ ⟧ʷ  γᴺ ⟧ᴱ)) ( toVal NT ⟧ᵛ  γᴺ ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)
                ≡⟨ cong  x   M ⟧ᵛ x ( toVal NT ⟧ᵛ  γᴺ ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)) (wk-sem-trans πᴺ π  γᴺ ⟧ᴱ) 
                  M ⟧ᵛ ( wk-trans πᴺ π ⟧ʷ  γᴺ ⟧ᴱ) ( toVal NT ⟧ᵛ  γᴺ ⟧ᴱ)  y   cs ⟧ᶜˢ  k  k y) k₀)
                ≡⟨ S≡T 
                 T ⟧ᶜꟴ )

    comp-eval-rec (var {A = X} M) γ π cs πₓ wk≡₀ with val-eval-rec {X = `V} M γ π
    ... | steps {T =  (( v̲a̲r̲ i)  γ₁  ) { = 🗆}} M>T ∙T M≡T π' wk≡ with lookup i γ₁
    ... | steps i>>T (found-comp {X = X} {W = W'} {γ = γ'} {cs = cs'} {π = πᶜ} {wk≡ = wk≡c}) i≡T π₂ w≡γ with
                    comp-eval-rec
                     W'
                     γ'
                     wk-id
                     cs'
                     πᶜ
                     wk≡c
    ... | steps {T = ∙⟨ C̲o̲m̲p.r̲e̲t̲u̲r̲n̲ M₁  γ₂   } W>T ret S≡T rewrite wk-comp-id W' =

                steps

                  ((∘⟨ var (wk-val π M)  γ  cs  →ᶜ⟨ ∘var M>T π' i>>T π₂  W>T))

                  ret

                  ((( π ⟧ʷ   M ⟧ᵛ)  varK)  γ ⟧ᴱ  cs ⟧ᴷ
                    ≡⟨ refl 
                       M ⟧ᵛ ( π ⟧ʷ  γ ⟧ᴱ)
                    ≡⟨ M≡T 
                       i ⟧ᵐ  γ₁ ⟧ᴱ
                    ≡⟨ i≡T 
                       W' ⟧ᶜ  γ' ⟧ᴱ  y   cs' ⟧ᶜˢ  k  k y) k₀)
                    ≡⟨ S≡T 
                      ( toVal M₁ ⟧ᵛ  η)  γ₂ ⟧ᴱ   ⟧ᴷ 
                  )

    comp-eval-rec (sub W V) γ π cs πₓ wk≡₀ with comp-eval-rec W ((γ ﹐﹝ wk-comp π V  cs ) {π = πₓ} {wk≡ = wk≡₀}) (wk-cong π) cs (wk-wk πₓ) wk≡₀
    ... | steps {T = T} W>WT HT S≡T =

                steps

                    (∘⟨ sub (wk-comp (wk-cong π) W) (wk-comp π V)  γ  cs  →ᶜ⟨ ∘sub  W>WT)

                    HT

                    S≡T

    comp-eval : (W : ε ⊢ᶜ R₀)  CompSteps ((∘⟨ wk-comp wk-id W     ) {π = wk-id} {wk≡ = refl})
    comp-eval W = comp-eval-rec W  wk-id  wk-id refl

postulate k₀ :  `Unit   R

open VMain {R₀ = `Unit} k₀
open CMain {R₀ = `Unit} k₀

---- Examples

-- s/\(PartialTerm\.\|ValStack\.\|Env\.\|V̲a̲l̲\.\|CompStack\.\|ValStack\.\|ValState\.\|_↠ᵛ_\.\|_→ᵛ_\.\|_→ᴸ\*_\.\|_→ᴸ_\.\|LookupState\.\|C̲o̲m̲p.\)//g

ex3 : ε ⊢ᶜ `Unit
ex3 = return (pm (pair unit unit) (var (t h)))

ex4 : ε ⊢ᶜ `Unit
ex4 = sub (var (var h)) (return (pm (pair unit unit) (var (t h))))

ex5 : ε ⊢ᶜ `Unit
ex5 = push (sub (push (return (var h)) (var (var h))) (return (pm (pair unit unit) (var (t h))))) (return (var h))

ex6 : ε ⊢ᶜ `Unit
ex6 = sub (var (pm (pair (var h) unit) (var (t h)))) (return unit)

ex7 : ε ⊢ᶜ `Unit
ex7 = push (sub (var (pm (pair (var h) unit) (var (t h)))) (return unit)) (return (var h))

{-
_ : comp-eval-test ex7 ≡

      steps
      (           ∘⟨ push (sub (var (pm (pair (var h) unit) (var (t h)))) (return unit)) (return (var h)) ⊰ ∗ ╎ ◻ ⟩
      →ᶜ⟨ ∘push ⟩ ∘⟨ sub (var (pm (pair (var h) unit) (var (t h)))) (return unit) ⊰ ∗ ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ⟩
      →ᶜ⟨ ∘sub ⟩ ∘⟨ var (pm (pair (var h) unit) (var (t h))) ⊰ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ⟩
      →ᶜ⟨ ∘var (           ∘ ⇡ pm (pair (var h) unit) (var (t h)) ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ □
                 →ᵛ⟨ ∘pm ⟩ ∘ ⇡ pair (var h) unit ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ ⇡ᴹ (pair (var h) unit) (var (t h)) ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ □
                 →ᵛ⟨ ∘pair ⟩ ∘ ⇡ var h ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ ⇡ᴸ (var h) unit ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ ⇡ᴹ (pair (var h) unit) (var (t h)) ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ □
                 →ᵛ⟨ ∘var-c ⟩ ∙ ⭭ v̲a̲r̲ h ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ ⇡ᴸ (var h) unit ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ ⇡ᴹ (pair (var h) unit) (var (t h)) ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ □
                 →ᵛ⟨ ∙M∷l ⟩ ∘ ⇡ unit ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ ⇡ᴿ (v̲a̲r̲ h) unit ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ ⇡ᴹ (pair (var h) unit) (var (t h)) ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ □
                 →ᵛ⟨ ∘unit ⟩ ∙ ⭭ u̲n̲i̲t̲ ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ ⇡ᴿ (v̲a̲r̲ h) unit ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ ⇡ᴹ (pair (var h) unit) (var (t h)) ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ □
                 →ᵛ⟨ ∙M∷r ⟩ ∙ ⭭ pa̲i̲r̲ (v̲a̲r̲ h) u̲n̲i̲t̲ ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ ⇡ᴹ (pair (var h) unit) (var (t h)) ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ □
                 →ᵛ⟨ ∙pair∷pm ⟩ ∘ ⇡ var (t h) ⊲ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ﹐ v̲a̲r̲ h ﹐ u̲n̲i̲t̲ ∷ □
                 →ᵛ⟨ ∘var-c ⟩.) (wk-wk (wk-wk (wk-cong wk-ε))) (                 ⟨ t h ∥ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ﹐ v̲a̲r̲ h ﹐ u̲n̲i̲t̲ ⟩
                                                                →ᴸ⟨ val-t-step ⟩ (⟨ h ∥ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ﹐ v̲a̲r̲ h ⟩
                                                                →ᴸ⟨ val-h-step ⟩ (⟨ h ∥ ∗ ﹐﹝ return unit ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ﹞ ⟩ ◼))) (wk-wk (wk-wk (wk-wk wk-ε)))⟩ ∘⟨ return unit ⊰ ∗ ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ⟩
      →ᶜ⟨ ∘return (∘ ⇡ unit ⊲ ∗ ∷ □ →ᵛ⟨ ∘unit ⟩.)⟩ ∙⟨ r̲e̲t̲u̲r̲n̲ u̲n̲i̲t̲ ⊰ ∗ ╎ return (var h) ⊲ ∗ ⦂⦂ ◻ ⟩
      →ᶜ⟨ ∙return ⟩ ∘⟨ return (var h) ⊰ ∗ ﹐ u̲n̲i̲t̲ ╎ ◻ ⟩
      →ᶜ⟨ ∘return (                         ∘ ⇡ var h ⊲ ∗ ﹐ u̲n̲i̲t̲ ∷ □
                   →ᵛ⟨ ∘var (⟨ h ∥ ∗ ﹐ u̲n̲i̲t̲ ⟩ ◼) (wk-wk wk-ε)⟩.)⟩ (∙⟨ r̲e̲t̲u̲r̲n̲ u̲n̲i̲t̲ ⊰ ∗ ﹐ u̲n̲i̲t̲ ╎ ◻ ⟩ ◼))
      (136 ∷ 58 ∷ 48 ∷ 12 ∷ 8 ∷ 5 ∷ 2 ∷ [])
_ = refl
-}

ex8 : ε ⊢ᶜ `Unit
ex8 = sub (push (var (var h)) (app (var h) unit)) (return unit)


ex9 : ε ⊢ᶜ `Unit
ex9 = sub (push (sub (return (var h)) ((return (var h)))) (var (var h))) (return unit)

{-
_ : comp-eval-test ex9 ≡
    steps
    (             ∘⟨ sub (push (sub (return (var h)) (return (var h))) (var (var h))) (return unit) ⊰ ∗ ╎ ◻ ⟩
    →ᶜ⟨ ∘sub ⟩    ∘⟨ push (sub (return (var h)) (return (var h))) (var (var h)) ⊰ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ╎ ◻ ⟩
    →ᶜ⟨ ∘push ⟩   ∘⟨ sub (return (var h)) (return (var h)) ⊰ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ╎
                                                                    var (var h) ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ⦂⦂ ◻ ⟩
    →ᶜ⟨ ∘sub ⟩    ∘⟨ return (var h) ⊰ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ﹐﹝ return (var h) ╎ var (var h) ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ⦂⦂ ◻ ﹞ ╎
                                                                    var (var h) ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ⦂⦂ ◻ ⟩
    →ᶜ⟨ ∘return (                 ∘ ⇡ var h ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ﹐﹝ return (var h) ╎ var (var h) ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ⦂⦂ ◻ ﹞ ∷ □
                  →ᵛ⟨ ∘var-c ⟩.) ⟩
                  ∙⟨ r̲e̲t̲u̲r̲n̲ (v̲a̲r̲ h) ⊰ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ﹐﹝ return (var h) ╎ var (var h) ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ⦂⦂ ◻ ﹞ ╎
                                                                    var (var h) ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ⦂⦂ ◻ ⟩
    →ᶜ⟨ ∙return ⟩ ∘⟨ var (var h) ⊰ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ﹐﹝ return (var h) ╎ var (var h) ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ⦂⦂ ◻ ﹞ ﹐ v̲a̲r̲ h ╎ ◻ ⟩
    →ᶜ⟨ ∘var     (                 ∘ ⇡ var h ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞
                                                 ﹐﹝ return (var h) ╎ var (var h) ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ⦂⦂ ◻ ﹞
                                                 ﹐ v̲a̲r̲ h ∷ □ →ᵛ⟨ ∘var-c ⟩.) (wk-cong (wk-cong (wk-cong wk-ε)))
                 (⟨ h ∥ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ﹐﹝ return (var h) ╎ var (var h) ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ⦂⦂ ◻ ﹞ ﹐ v̲a̲r̲ h ⟩
                  →ᴸ⟨ val-h-step ⟩ (⟨ h ∥ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ﹐﹝ return (var h) ╎ var (var h) ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ⦂⦂ ◻ ﹞ ⟩ ◼))
                 (wk-wk (wk-wk (wk-cong wk-ε))) ⟩
                  ∘⟨ return (var h) ⊰ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ╎ var (var h) ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ⦂⦂ ◻ ⟩
    →ᶜ⟨ ∘return (∘ ⇡ var h ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ∷ □ →ᵛ⟨ ∘var-c ⟩.) ⟩
                  ∙⟨ r̲e̲t̲u̲r̲n̲ (v̲a̲r̲ h) ⊰ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ╎ var (var h) ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ⦂⦂ ◻ ⟩
    →ᶜ⟨ ∙return ⟩ ∘⟨ var (var h) ⊰ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ﹐ v̲a̲r̲ h ╎ ◻ ⟩
    →ᶜ⟨ ∘var    (∘ ⇡ var h ⊲ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ﹐ v̲a̲r̲ h ∷ □ →ᵛ⟨ ∘var-c ⟩.) (wk-cong (wk-cong wk-ε)) (⟨ h ∥ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ﹐ v̲a̲r̲ h ⟩
                                                                     →ᴸ⟨ val-h-step ⟩ (⟨ h ∥ ∗ ﹐﹝ return unit ╎ ◻ ﹞ ⟩ ◼)) (wk-wk (wk-wk wk-ε)) ⟩
                  ∘⟨ return unit ⊰ ∗ ╎ ◻ ⟩
    →ᶜ⟨ ∘return (∘ ⇡ unit ⊲ ∗ ∷ □ →ᵛ⟨ ∘unit ⟩.) ⟩
                 (∙⟨ r̲e̲t̲u̲r̲n̲ u̲n̲i̲t̲ ⊰ ∗ ╎ ◻ ⟩ ◼))
    (244 ∷ 239 ∷ 67 ∷ 49 ∷ 45 ∷ 23 ∷ 19 ∷ 15 ∷ 8 ∷ 4 ∷ 2 ∷ [])
_ = refl
-}

ex10 : ε ⊢ᶜ `Unit
ex10 = push (sub (push (var (var h)) (app (var h) unit)) (return unit)) (return unit)

{-
_ : comp-eval-test ex10 ≡
  steps
  (             ∘⟨ push (sub (push (var (var h)) (app (var h) unit)) (return unit)) (return unit) ⊰ ∗ ╎ ◻ ⟩
  →ᶜ⟨ ∘push ⟩   ∘⟨ sub (push (var (var h)) (app (var h) unit)) (return unit) ⊰ ∗ ╎ return unit ⊲ ∗ ⦂⦂ ◻ ⟩
  →ᶜ⟨ ∘sub ⟩    ∘⟨ push (var (var h)) (app (var h) unit) ⊰ ∗ ﹐﹝ return unit ╎ return unit ⊲ ∗ ⦂⦂ ◻ ﹞ ╎ return unit ⊲ ∗ ⦂⦂ ◻ ⟩
  →ᶜ⟨ ∘push ⟩   ∘⟨ var (var h) ⊰ ∗ ﹐﹝ return unit ╎ return unit ⊲ ∗ ⦂⦂ ◻ ﹞ ╎ app (var h) unit ⊲ ∗ ﹐﹝ return unit ╎ return unit ⊲ ∗ ⦂⦂ ◻ ﹞ ⦂⦂ (return unit ⊲ ∗ ⦂⦂ ◻) ⟩
  →ᶜ⟨ ∘var (∘ ⇡ var h ⊲ ∗ ﹐﹝ return unit ╎ return unit ⊲ ∗ ⦂⦂ ◻ ﹞ ∷ □ →ᵛ⟨ ∘var-c ⟩.) (wk-cong wk-ε) (⟨ h ∥ ∗ ﹐﹝ return unit ╎ return unit ⊲ ∗ ⦂⦂ ◻ ﹞ ⟩ ◼) (wk-wk wk-ε) ⟩
                ∘⟨ return unit ⊰ ∗ ╎ return unit ⊲ ∗ ⦂⦂ ◻ ⟩
  →ᶜ⟨ ∘return (∘ ⇡ unit ⊲ ∗ ∷ □ →ᵛ⟨ ∘unit ⟩.) ⟩
                ∙⟨ r̲e̲t̲u̲r̲n̲ u̲n̲i̲t̲ ⊰ ∗ ╎ return unit ⊲ ∗ ⦂⦂ ◻ ⟩
  →ᶜ⟨ ∙return ⟩ ∘⟨ return unit ⊰ ∗ ﹐ u̲n̲i̲t̲ ╎ ◻ ⟩
  →ᶜ⟨ ∘return (∘ ⇡ unit ⊲ ∗ ﹐ u̲n̲i̲t̲ ∷ □ →ᵛ⟨ ∘unit ⟩.) ⟩
               (∙⟨ r̲e̲t̲u̲r̲n̲ u̲n̲i̲t̲ ⊰ ∗ ﹐ u̲n̲i̲t̲ ╎ ◻ ⟩ ◼))
  (63 ∷ 38 ∷ 33 ∷ 32 ∷ 8 ∷ 6 ∷ 4 ∷ 2 ∷ [])
_ = refl
-}

ex11 : ε ⊢ᶜ `Unit
ex11 = app (lam (app (lam (push (sub (push (var (var h)) (app (var h) unit)) (return (lam (return (var h))))) (app (var h) unit))) unit)) unit

ex12 : ε ⊢ᶜ `Unit
ex12 = push (return unit) (return (pm (pair (pair unit unit) (pair unit unit)) unit))

ex13 : ε ⊢ᶜ `Unit
ex13 = sub ((var (var h))) (return (pm (pair (pair unit unit) (pair unit unit)) unit))

ex14 : ε ⊢ᶜ (`Unit)
ex14 = push (push (app (lam {A = `Unit} (sub (var (var h)) (return unit))) unit) (return unit)) (app (lam (return unit)) (pair (pair (pair (var h) (var h)) (var h)) (var h)))

ex15 : ε ⊢ᶜ (`Unit)
ex15 = push (push (app (lam {A = `Unit} (sub (var (var h)) (return unit))) unit) (return unit)) (return unit)

-- _ : comp-eval ex15 ≡ {! comp-eval ex15 !}
-- _ = refl