Finalized a version of the mirror example using the standard library.

Ignore-this: 4aa6c329d508c0a7472f3884d5b85557

darcs-hash:20110211131217-3bd4e-de3f5e6d21d012ceac60d15886b0a527a423abc8.gz

module MirrorStdLib where

open import Algebra
open import Data.List as List hiding ( reverse )
open import Data.List.Properties

open import Relation.Binary.PropositionalEquality
open ≡-Reasoning

module LM {A : Set} = Monoid (List.monoid A)

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

reverse : {A : Set} → List A → List A
reverse []       = []
reverse (x ∷ xs) = reverse xs ++ x ∷ []

++-rightIdentity : {A : Set}(xs : List A) → xs ++ [] ≡ xs
++-rightIdentity []       = refl
++-rightIdentity (x ∷ xs) = cong (_∷_ x) (++-rightIdentity xs)

reverse-++ : {A : Set}(xs ys : List A) →
             reverse (xs ++ ys) ≡ reverse ys ++ reverse xs
reverse-++ [] ys       = sym (++-rightIdentity (reverse ys))
reverse-++ (x ∷ xs) [] = cong (λ x' → reverse x' ++ x ∷ []) (++-rightIdentity xs)
reverse-++ (x ∷ xs) (y ∷ ys) =
  begin
    reverse (xs ++ y ∷ ys) ++ x ∷ []
      ≡⟨ cong (λ x' → x' ++ x ∷ []) (reverse-++ xs (y ∷ ys)) ⟩
    (reverse (y ∷ ys) ++ reverse xs) ++ x ∷ []
      ≡⟨ LM.assoc (reverse (y ∷ ys)) (reverse xs) (x ∷ []) ⟩
    reverse (y ∷ ys) ++ reverse (x ∷ xs)
  ∎

data Tree (A : Set) : Set where
  treeT : A → List (Tree A) → Tree A

mirror : {A : Set} → Tree A → Tree A
mirror (treeT a ts) = treeT a (reverse (map mirror ts))

mutual
  mirror² : {A : Set} → (t : Tree A) → mirror (mirror t) ≡ t
  mirror² (treeT a [])       = refl
  mirror² (treeT a (t ∷ ts)) =
    begin
      treeT a (reverse (map mirror (reverse (map mirror ts) ++ mirror t ∷ [])))
        ≡⟨ subst (λ x → treeT a (reverse (map mirror (reverse (map mirror ts) ++
                                                      mirror t ∷ []))) ≡
                        treeT a x)
           (aux (t ∷ ts))
           refl
        ⟩
      treeT a (t ∷ ts)
    ∎

  aux : {A : Set} → (ts : List (Tree A)) →
        reverse (map mirror (reverse (map mirror ts))) ≡ ts
  aux []       = refl
  aux (t ∷ ts) =
    begin
      reverse (map mirror (reverse (map mirror ts) ++ mirror t ∷ []))
        ≡⟨ subst (λ x → (reverse (map mirror (reverse (map mirror ts) ++
                                              mirror t ∷ []))) ≡
                        reverse x)
           (map-++-commute mirror (reverse (map mirror ts)) (mirror t ∷ []))
           refl
        ⟩
      reverse (map mirror (reverse (map mirror ts)) ++
                          (map mirror (mirror t ∷ [])))
        ≡⟨ subst (λ x → (reverse (map mirror (reverse (map mirror ts)) ++
                                             (map mirror (mirror t ∷ [])))) ≡
                        x)
                 (reverse-++ (map mirror (reverse (map mirror ts)))
                             (map mirror (mirror t ∷ [])))
                 refl
        ⟩
      reverse (map mirror (mirror t ∷ [])) ++
              reverse (map mirror (reverse (map mirror ts)))
              ≡⟨ refl ⟩
      mirror (mirror t) ∷ reverse (map mirror (reverse (map mirror ts)))
        ≡⟨ subst (λ x → (mirror (mirror t) ∷
                                reverse (map mirror (reverse (map mirror ts)))) ≡
                        (x ∷ reverse (map mirror (reverse (map mirror ts)))))
                 (mirror² t)  -- IH.
                 refl
        ⟩
      t ∷ reverse (map mirror (reverse (map mirror ts)))
        ≡⟨ subst (λ x → t ∷ reverse (map mirror (reverse (map mirror ts))) ≡
                        t ∷ x)
                 (aux ts)
                 refl
        ⟩
      t ∷ ts
    ∎

module MirrorStdLib where

open import Algebra
open import Data.List as List hiding ( reverse )
open import Data.List.Properties

open import Relation.Binary.PropositionalEquality
open ≡-Reasoning

module LM {A : Set} = Monoid (List.monoid A)

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

reverse : {A : Set} → List A → List A
reverse []       = []
reverse (x ∷ xs) = reverse xs ++ x ∷ []

++-rightIdentity : {A : Set}(xs : List A) → xs ++ [] ≡ xs
++-rightIdentity []       = refl
++-rightIdentity (x ∷ xs) = cong (_∷_ x) (++-rightIdentity xs)

reverse-++ : {A : Set}(xs ys : List A) →
             reverse (xs ++ ys) ≡ reverse ys ++ reverse xs
reverse-++ [] ys       = sym (++-rightIdentity (reverse ys))
reverse-++ (x ∷ xs) [] = cong (λ x' → reverse x' ++ x ∷ []) (++-rightIdentity xs)
reverse-++ (x ∷ xs) (y ∷ ys) =
  begin
    reverse (xs ++ y ∷ ys) ++ x ∷ []
      ≡⟨ cong (λ x' → x' ++ x ∷ []) (reverse-++ xs (y ∷ ys)) ⟩
    (reverse (y ∷ ys) ++ reverse xs) ++ x ∷ []
      ≡⟨ LM.assoc (reverse (y ∷ ys)) (reverse xs) (x ∷ []) ⟩
    reverse (y ∷ ys) ++ reverse (x ∷ xs)
  ∎

data Tree (A : Set) : Set where
  treeT : A → List (Tree A) → Tree A

mirror : {A : Set} → Tree A → Tree A
mirror (treeT a ts) = treeT a (reverse (map mirror ts))

mirror² : {A : Set} → (t : Tree A) → mirror (mirror t) ≡ t
mirror² (treeT a [])       = refl
mirror² (treeT a (t ∷ ts)) =
  begin
    treeT a (reverse (map mirror (reverse (map mirror ts) ++ mirror t ∷ [])))
      ≡⟨ subst (λ x → treeT a (reverse (map mirror (reverse (map mirror ts) ++
                                                    mirror t ∷ []))) ≡
                      treeT a (reverse x))
         (map-++-commute mirror (reverse (map mirror ts)) (mirror t ∷ []))
         refl
      ⟩
    treeT a (reverse (map mirror (reverse (map mirror ts)) ++
                     (map mirror (mirror t ∷ []))))
      ≡⟨ subst (λ x → treeT a (reverse (map mirror (reverse (map mirror ts)) ++
                                       (map mirror (mirror t ∷ [])))) ≡
                      treeT a x)
               (reverse-++ (map mirror (reverse (map mirror ts)))
                           (map mirror (mirror t ∷ [])))
               refl
      ⟩
    treeT a (reverse (map mirror (mirror t ∷ [])) ++
             reverse (map mirror (reverse (map mirror ts))))
      ≡⟨ refl ⟩
    treeT a (mirror (mirror t) ∷ reverse (map mirror (reverse (map mirror ts))))
      ≡⟨ subst (λ x → treeT a (mirror (mirror t) ∷
                                reverse (map mirror (reverse (map mirror ts)))) ≡
                      treeT a (x ∷ reverse (map mirror (reverse (map mirror ts)))))
               (mirror² t)  -- IH.
               refl
      ⟩
    treeT a (t ∷ reverse (map mirror (reverse (map mirror ts))))
      ≡⟨ {!!} ⟩
    treeT a (t ∷ ts)
  ∎


Build fix

Build fix

{-# OPTIONS --allow-unsolved-metas #-}
module Thesis.BigStep where

open import Data.Empty
open import Data.Unit
open import Relation.Binary.PropositionalEquality
open import Relation.Binary hiding (_⇒_)
open import Data.Nat using (ℕ; zero; suc; decTotalOrder; _<_)

open import Thesis.Syntax hiding (suc)
open import Thesis.Lang hiding (⟦_⟧Context; ⟦_⟧Var; suc)

-- open import Base.Syntax.Context Type public
-- open import Base.Syntax.Vars Type public

-- data Const : (τ : Type) → Set where
--   lit : ℤ → Const int
--   -- succ : Const (int ⇒ int)

-- data Term (Γ : Context) :
--   (τ : Type) → Set where
--   -- constants aka. primitives
--   const : ∀ {τ} →
--     (c : Const τ) →
--     Term Γ τ
--   var : ∀ {τ} →
--     (x : Var Γ τ) →
--     Term Γ τ
--   app : ∀ {σ τ}
--     (s : Term Γ (σ ⇒ τ)) →
--     (t : Term Γ σ) →
--     Term Γ τ
--   -- we use de Bruijn indices, so we don't need binding occurrences.
--   abs : ∀ {σ τ}
--     (t : Term (σ • Γ) τ) →
--     Term Γ (σ ⇒ τ)

data Val : Type → Set
open import Base.Denotation.Environment Type Val public
open import Base.Data.DependentList public

data Val where
  closure : ∀ {Γ σ τ} → (t : Term (σ • Γ) τ) → (ρ : ⟦ Γ ⟧Context) → Val (σ ⇒ τ)
  intV : ∀ (n : ℤ) → Val int
  -- prim : ∀ {σ τ} → (f : Val σ → Val τ) → Val (σ ⇒ τ)
  -- prim : ∀ {σ τ} → (f : ⟦ σ ⇒ τ ⟧Type) → Val (σ ⇒ τ)
  pairV : ∀ {σ τ} → Val σ → Val τ → Val (pair σ τ)
  -- prim : ∀ {σ τ} → (f : ⟦ σ ⟧Type → Val τ) → Val (σ ⇒ τ)

-- TODO: add defunctionalized interpretations for primitives. Yes, annoying but mechanical.

-- Doesn't work
-- data Val2 : ℕ → Type → Set where
--   prim : ∀ {σ τ n} → (f : Val2 n σ → Val2 n τ) → Val2 (ℕ.suc n) (σ ⇒ τ)

import Base.Denotation.Environment
-- Den stands for Denotational semantics.
module Den = Base.Denotation.Environment Type ⟦_⟧Type

⟦_⟧Val : ∀ {τ} → Val τ → ⟦ τ ⟧Type
⟦_⟧Env : ∀ {Γ} → ⟦ Γ ⟧Context → Den.⟦ Γ ⟧Context

⟦ ∅ ⟧Env = ∅
⟦ v • ρ ⟧Env = ⟦ v ⟧Val • ⟦ ρ ⟧Env

⟦ closure t ρ ⟧Val = λ v → (⟦ t ⟧Term) (v • ⟦ ρ ⟧Env)
⟦ intV n ⟧Val = n
-- ⟦ prim f ⟧Val = λ v → ⟦ f v ⟧Val
⟦ pairV a b ⟧Val = (⟦ a ⟧Val , ⟦ b ⟧Val)
-- ⟦ true ⟧Val = true
-- ⟦ false ⟧Val = false

↦-sound : ∀ {Γ τ} ρ (x : Var Γ τ) →
  Den.⟦ x ⟧Var ⟦ ρ ⟧Env ≡ ⟦ ⟦ x ⟧Var ρ ⟧Val
↦-sound (px • ρ) this = refl
↦-sound (px • ρ) (that x) = ↦-sound ρ x

--
-- Functional big-step semantics
--

-- Termination is far from obvious to Agda once we use closures. So we use
-- step-indexing with a fuel value, following "Type Soundness Proofs with
-- Definitional Interpreters". Since we focus for now on STLC, unlike that
-- paper, we can avoid error values by keeping types.
--
-- One could drop types and add error values, to reproduce what they do.

data ErrVal (τ : Type) : Set where
  Done : (v : Val τ) → ErrVal τ
  TimeOut : ErrVal τ

Res : Type → Set
Res τ = ℕ → ErrVal τ

evalConst : ∀ {τ} → Const τ → Res τ
evalConst (lit v) n = Done (intV v)
evalConst c n = {!!}

-- evalConst plus n = Done (prim (λ a → prim (λ b → intV (a + b))))
-- evalConst minus n = Done (prim (λ a → prim (λ b → intV (a - b))))
-- evalConst cons n = Done (prim (λ a → prim (λ b → {!pairV !})))
-- evalConst fst n = {!!}
-- evalConst snd n = {!!}
-- evalConst linj n = {!!}
-- evalConst rinj n = {!!}
-- evalConst match n = {!!}
-- evalConst zero = intV (+ 0)
-- evalConst succ = {!!}

eval : ∀ {Γ τ} → Term Γ τ → ⟦ Γ ⟧Context → Res τ

apply : ∀ {σ τ} → Val (σ ⇒ τ) → Val σ → Res τ
apply (closure t ρ) a n = eval t (a • ρ) n
-- apply (prim f) a n = Done (f ⟦ a ⟧Val)

eval t ρ zero = TimeOut
eval (const c) ρ (suc n) = evalConst c n
eval (var x) ρ (suc n) = Done (⟦ x ⟧Var ρ)
eval (abs t) ρ (suc n) = Done (closure t ρ)
eval (app s t) ρ (suc n) with eval s ρ n | eval t ρ n
... | Done f | Done a = apply f a n
... | _ | _ = TimeOut
-- eval t0 ρ (suc n) with t0
-- ... | const c = evalConst c n
-- ... | var x = Done (⟦ x ⟧Var ρ)
-- ... | abs t = Done (closure t ρ)
-- ... | app s t with eval s ρ n | eval t ρ n
-- ... | Done f | Done a = apply f a n
-- ... | _ | _ = TimeOut

-- Can we prove eval sound wrt. our reference denotational semantics? Yes! Very
-- cool!
eval-sound : ∀ {Γ τ} ρ v n (t : Term Γ τ) →
  eval t ρ n ≡ Done v →
  ⟦ t ⟧Term ⟦ ρ ⟧Env ≡ ⟦ v ⟧Val

apply-sound : ∀ {Γ σ τ} ρ v f a n (s : Term Γ (σ ⇒ τ)) t →
  ⟦ s ⟧Term ⟦ ρ ⟧Env ≡ ⟦ f ⟧Val →
  ⟦ t ⟧Term ⟦ ρ ⟧Env ≡ ⟦ a ⟧Val →
  apply f a n ≡ Done v →
  ⟦ s ⟧Term ⟦ ρ ⟧Env (⟦ t ⟧Term ⟦ ρ ⟧Env) ≡ ⟦ v ⟧Val
apply-sound _ v (closure ft ρ) a n s t feq aeq eq rewrite feq | aeq = eval-sound (a • ρ) v n ft eq

eval-sound ρ v zero t ()
eval-sound ρ v (ℕ.suc n) (const c) eq = {!!}
eval-sound ρ v (ℕ.suc n) (var x) refl = ↦-sound ρ x
eval-sound ρ v (ℕ.suc n) (abs t) refl = refl
eval-sound ρ v (ℕ.suc n) (app s t) eq with eval s ρ n | inspect (eval s ρ) n | eval t ρ n | inspect (eval t ρ) n
eval-sound ρ v (ℕ.suc n) (app s t) eq | Done f | [ feq ] | Done a | [ aeq ] =
  let feq = eval-sound ρ f n s feq; aeq = eval-sound ρ a n t aeq in apply-sound ρ v f a n s t feq aeq eq
eval-sound ρ v (ℕ.suc n) (app s t) () | Done f | _ | TimeOut | _
eval-sound ρ v (ℕ.suc n) (app s t) () | TimeOut | _ | _ | _
-- eval-sound n (const c) eq = {!!}
-- eval-sound n (var x) eq = {!!}
-- eval-sound n (app s t) eq = {!!} -- with eval s ρ n
-- eval-sound n (abs t) eq = {!!}
-- eval-sound n (const c) eq = {!!}
-- eval-sound n (var x) eq = {!!}
-- eval-sound n (app s t) eq = {!!} -- with eval s ρ n
-- eval-sound n (abs t) eq = {!!}

-- Next, we can try defining change structures and validity.

dapply : ∀ {σ τ} → Val (Δt (σ ⇒ τ)) → Val σ → Val (Δt σ) → Res (Δt τ)
dapply df a1 da zero = TimeOut
dapply df a1 da (suc zero) = TimeOut
dapply df a1 da (suc (suc n)) with apply df a1 n
... | Done dfa = apply dfa da (suc n)
... | TimeOut = TimeOut

-- apply (closure (abs (derive t)) dρ) a1 (suc (suc n))
-- eval (derive (abs t)) dρ (suc n) ≡
-- dapply-sound-0
--   dapply (closure (abs (derive t)) dρ) a1 da (suc n) ≡
--   eval (derive t) (da • a1 • dρ) n

dapply' : ∀ {σ τ} → ErrVal (Δt (σ ⇒ τ)) → ErrVal σ → ErrVal (Δt σ) → Res (Δt τ)
dapply' (Done df) (Done v) (Done dv) n = dapply df v dv n
dapply' _ _ _ _ = TimeOut

-- Which step-indexes should we use in dapply's specification and
-- implementation? That's highly non-obvious. To come up with them, I had to
-- step through the evaluation of eval (app (app ds t) dt), and verify that I
-- never invoke eval or apply on the same inputs at different step-indexes.
--
-- However, I expect I wouldn't be able to get a working proof if I got the
-- indexes wrong.
dapply-sound : ∀ {Γ σ τ} n ρ (ds : Term Γ (Δt (σ ⇒ τ))) t dt →
    eval (app (app ds t) dt) ρ (suc (suc n))
  ≡
    dapply' (eval ds ρ n) (eval t ρ n) (eval dt ρ (suc n)) (suc (suc n))
dapply-sound zero ρ ds t dt = refl
dapply-sound (suc n) ρ ds t dt with
  eval ds ρ (suc n) | eval t ρ (suc n) | eval dt ρ (suc (suc n))
dapply-sound (suc n) ρ ds t dt | Done df | Done v | Done dv with apply df v (suc n)
... | Done dfv = refl
... | TimeOut  = refl
dapply-sound (suc n) ρ ds t dt | Done df | Done v | TimeOut with apply df v (suc n)
... | Done dfv = refl
... | TimeOut = refl
dapply-sound (suc n) ρ ds t dt | Done df | TimeOut | dv = refl
dapply-sound (suc n) ρ ds t dt | TimeOut | v | dv = refl

ΔΓ : Context → Context
ΔΓ ∅ = ∅
ΔΓ (τ • Γ) = Δt τ • τ • ΔΓ Γ

ChΓ : ∀ (Γ : Context) → Set
ChΓ Γ = ⟦ ΔΓ Γ ⟧Context
Γ≼ΔΓ : ∀ {Γ} → Γ ≼ ΔΓ Γ
Γ≼ΔΓ {∅} = ∅
Γ≼ΔΓ {τ • Γ} = drop Δt τ • keep τ • Γ≼ΔΓ

fit : ∀ {τ Γ} → Term Γ τ → Term (ΔΓ Γ) τ
fit = weaken Γ≼ΔΓ

deriveConst : ∀ {τ} →
  Const τ →
  Term ∅ (Δt τ)
deriveConst = {!!}

derive-var : ∀ {Γ τ} → Var Γ τ → Var (ΔΓ Γ) (Δt τ)
derive-var this = this
derive-var (that x) = that (that (derive-var x))

derive : ∀ {Γ τ} → Term Γ τ → Term (ΔΓ Γ) (Δt τ)
derive (const c) = weaken (∅≼Γ {ΔΓ _}) (deriveConst c)
derive (var x) = var (derive-var x)
derive (app s t) = app (app (derive s) (fit t)) (derive t)
derive (abs t) = abs (abs (derive t))

-- open import Thesis.Derive
Chτ : Type → Set
Chτ τ = Val (Δt τ)

deval : ∀ {Γ τ} → (t : Term Γ τ) → (ρ : ⟦ Γ ⟧Context) (dρ : ChΓ Γ) → Res (Δt τ)
deval t ρ dρ = eval (derive t) dρ

dapply-equiv : ∀ {Γ σ τ} n
  (t : Term (σ • Γ) τ)
  (dρ : ChΓ Γ) (ρ1 : ⟦ Γ ⟧Context)
  (da : Val (Δt σ)) (a1 : Val σ) →
  dapply (closure (abs (derive t)) dρ) a1 da (suc (suc (suc n))) ≡
  eval (derive t) (da • a1 • dρ) (suc (suc n))
dapply-equiv n t dρ ρ1 da a1 = refl

-- Target statement:

_[_]τ_from_to_ : (n : ℕ) → ∀ τ → Val (Δt τ) → Val τ → Val τ → Set
_[_]τ'_from_to_ : (n : ℕ) → ∀ τ → ErrVal (Δt τ) → ErrVal τ → ErrVal τ → Set
n [ τ ]τ' Done dv from Done v1 to Done v2 = n [ τ ]τ dv from v1 to v2
n [ τ ]τ' TimeOut from Done v1 to Done v2 = ⊥
n [ τ ]τ' dv from _ to _ = ⊤

-- XXX: This is a lie for now, but all papers agree we'll want this in the end.
_[_]τmono_from_to : (n : ℕ) → ∀ τ → (dv : Val (Δt τ)) →
  ∀ v1 v2 n' →
  n' < n →
  n [ τ ]τ dv from v1 to v2 →
  n' [ τ ]τ dv from v1 to v2
_[_]τmono_from_to = {!!}

_[_]τ'_fromToTimeOut : ∀ n τ edv → n [ τ ]τ' edv from TimeOut to TimeOut ≡ ⊤
n [ τ ]τ' Done v fromToTimeOut = refl
n [ τ ]τ' TimeOut fromToTimeOut = refl
-- n [ τ ]τ' dv from Done v1 to TimeOut = ⊤
-- n [ τ ]τ' dv from TimeOut to Done v2 = ⊤
-- n [ τ ]τ' dv from TimeOut to TimeOut = ⊤

-- In the static-caching paper, the specification we use is similar to this one:
-- n [ σ ⇒ τ ]τ df from f1 to f2 = ∀ (da : Val (Δt σ)) → (a1 a2 : Val σ) →
--    n [ σ ]τ da from a1 to a2 →
--    ∀ v1 v2 → apply f1 a1 n ≡ Done v1 → apply f2 a2 n ≡ Done v2 →
--    Σ[ dv ∈ Val (Δt τ) ]
--        dapply df a1 da n ≡ Done dv
--      × n [ τ ]τ dv from v1 to v2
-- I defined _[_]τ'_from_to_ to be able to write an equivalent (hopefully) specification more quickly.

zero [ τ ]τ dv from v1 to v2 = ⊤
-- suc n [ σ ⇒ τ ]τ df from f1 to f2 =
--   ∀ (da : Val (Δt σ)) → (a1 a2 : Val σ) →
--    n [ σ ]τ da from a1 to a2 →
--    n [ τ ]τ' dapply df a1 da n from apply f1 a1 n to apply f2 a2 n

suc n [ σ ⇒ τ ]τ df from f1 to f2 = ∀ (da : Val (Δt σ)) → (a1 a2 : Val σ) →
   suc n [ σ ]τ da from a1 to a2 →

-- This definition violates all tips from Pitts tutorial (Step-Indexed
-- Biorthogonality: a Tutorial Example). Compare with Definition 4.1,
-- equation (10), and remark 4.4.
--
-- For extra complication, the setting is rather different, so a direct
-- comparison doesn't quite work.
   ∀ v1 v2 → apply f1 a1 (suc n) ≡ Done v1 → apply f2 a2 (suc n) ≡ Done v2 →
   Σ[ dv ∈ Val (Δt τ) ]
       dapply df a1 da (suc (suc n)) ≡ Done dv
     × n [ τ ]τ dv from v1 to v2

suc n [ int ]τ intV dn from intV n1 to intV n2 = n1 + dn ≡ n2
suc n [ unit ]τ dv from v1 to v2 = ⊤
suc n [ pair σ τ ]τ pairV da db from pairV a1 b1 to pairV a2 b2 =
  suc n [ σ ]τ da from a1 to a2 × suc n [ τ ]τ db from b1 to b2
suc n [ sum σ τ ]τ () from v1 to v2

data _[_]Γ_from_to_ : ∀ ℕ Γ → ChΓ Γ → (ρ1 ρ2 : ⟦ Γ ⟧Context) → Set where
  v∅ : ∀ {n} → n [ ∅ ]Γ ∅ from ∅ to ∅
  _v•_ : ∀ {n τ Γ dv v1 v2 dρ ρ1 ρ2} →
    (dvv : n [ τ ]τ dv from v1 to v2) →
    (dρρ : n [ Γ ]Γ dρ from ρ1 to ρ2) →
    n [ τ • Γ ]Γ (dv • v1 • dρ) from (v1 • ρ1) to (v2 • ρ2)

fromtoDeriveVar : ∀ {Γ} τ n → (x : Var Γ τ) →
  (dρ : ChΓ Γ) (ρ1 ρ2 : ⟦ Γ ⟧Context) → n [ Γ ]Γ dρ from ρ1 to ρ2 →
    n [ τ ]τ (⟦ derive-var x ⟧Var dρ) from ⟦ x ⟧Var ρ1 to ⟦ x ⟧Var ρ2
fromtoDeriveVar τ n this (dv • .(v1 • _)) (v1 • ρ1) (v2 • ρ2) (dvv v• dρρ) = dvv
fromtoDeriveVar τ n (that x) (dv • (.v1 • dρ)) (v1 • ρ1) (v2 • ρ2) (dvv v• dρρ) = fromtoDeriveVar τ n x dρ ρ1 ρ2 dρρ

foo : ∀ {Γ σ τ v1 v2 dv} n (t : Term (σ • Γ) τ) →
  (dρ : ChΓ Γ) (ρ1 ρ2 : ⟦ Γ ⟧Context)
  (da : Val (Δt σ)) (a1 a2 : Val σ) →
  (eqv1 : eval t (a1 • ρ1) (suc (suc n)) ≡ Done v1) →
  (eqv2 : eval t (a2 • ρ2) (suc (suc n)) ≡ Done v2) →
  (eqvv : eval (derive t) (da • a1 • dρ) (suc (suc n)) ≡ Done dv) →
  suc (suc n) [ τ ]τ' eval (derive t) (da • a1 • dρ) (suc (suc n)) from
      eval t (a1 • ρ1) (suc (suc n)) to eval t (a2 • ρ2) (suc (suc n)) →
  suc n [ τ ]τ dv from v1 to v2
foo n t dρ ρ1 ρ2 da a1 a2 eqv1 eqv2 eqvv dvv with eval t (a1 • ρ1) (suc (suc n)) | eval t (a2 • ρ2) (suc (suc n)) | eval (derive t) (da • a1 • dρ) (suc (suc n))
foo n t dρ ρ1 ρ2 da a1 a2 refl refl refl dvv | Done v1 | (Done v2) | (Done dv) = _[_]τmono_from_to (suc (suc n)) _ dv v1 v2 (suc n) (DecTotalOrder.reflexive Data.Nat.decTotalOrder refl) dvv
foo n t dρ ρ1 ρ2 da a1 a2 refl refl () dvv | Done v₁ | (Done v) | TimeOut
foo n t dρ ρ1 ρ2 da a1 a2 refl () eqvv dvv | Done v | TimeOut | s
foo n t dρ ρ1 ρ2 da a1 a2 () eqv2 eqvv dvv | TimeOut | r | s
-- q r s eqv1 eqv2 eqvv

fromtoDerive : ∀ {Γ} τ n → (t : Term Γ τ) →
  (dρ : ChΓ Γ) (ρ1 ρ2 : ⟦ Γ ⟧Context) → n [ Γ ]Γ dρ from ρ1 to ρ2 →
    n [ τ ]τ' (deval t ρ1 dρ n) from eval t ρ1 n to eval t ρ2 n
fromtoDerive τ zero t dρ ρ1 ρ2 dρρ rewrite zero [ τ ]τ' (deval t ρ1 dρ (suc zero)) fromToTimeOut = tt
fromtoDerive τ (suc n) (const c) dρ ρ1 ρ2 dρρ = {!!}
fromtoDerive τ (suc n) (var x) dρ ρ1 ρ2 dρρ = fromtoDeriveVar τ (suc n) x dρ ρ1 ρ2 dρρ
fromtoDerive τ (suc n) (app s t) dρ ρ1 ρ2 dρρ = {!fromtoDerive _ (suc n) s dρ ρ1 ρ2 dρρ!}
-- fromtoDerive (σ ⇒ τ) (suc n) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa
--   rewrite dapply-equiv n t dρ ρ1 da a1 =
--   fromtoDerive τ (suc n) t (da • a1 • dρ) (a1 • ρ1) (a2 • ρ2) (daa v• dρρ)
fromtoDerive (σ ⇒ τ) (suc zero) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa v1 v2 eqv1 eqv2 = {!LIE!!}
fromtoDerive (σ ⇒ τ) (suc (suc n)) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa v1 v2 eqv1 eqv2 with
  eval (derive t) (da • a1 • dρ) (suc (suc n)) | inspect (eval (derive t) (da • a1 • dρ)) (suc (suc n))
fromtoDerive (σ ⇒ τ) (suc (suc n)) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa v1 v2 eqv1 eqv2 | Done dv | [ eqvv ] = dv , refl , foo n t  dρ ρ1 ρ2 da a1 a2 eqv1 eqv2 eqvv (fromtoDerive τ (suc (suc n)) t (da • a1 • dρ) (a1 • ρ1) (a2 • ρ2) (daa v• dρρ))
fromtoDerive (σ ⇒ τ) (suc (suc n)) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa v1 v2 eqv1 eqv2 | TimeOut | eq = {!LIE!!}
-- {!eval (derive t)!} , {!fromtoDerive τ (suc n) t (da • a1 • dρ) (a1 • ρ1) (a2 • ρ2) ?!}

-- fromtoDerive (σ ⇒ τ) (suc (suc zero)) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa = {!!}
-- fromtoDerive (σ ⇒ τ) (suc (suc (suc n))) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa
--   with eval (abs (derive t)) (a1 • dρ) n | inspect (eval (abs (derive t)) (a1 • dρ)) n
-- fromtoDerive (σ ⇒ τ) (suc (suc (suc n))) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa | Done v | [ eq ] = {!fromtoDerive τ (suc (suc n)) t (da • a1 • dρ) (a1 • ρ1) (a2 • ρ2) _!}
-- fromtoDerive (σ ⇒ τ) (suc (suc (suc n))) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa | TimeOut | _ = {!!}
-- --   fromtoDerive τ n t (da • a1 • dρ) (a1 • ρ1) (a2 • ρ2) (daa v• ?)
-- -- fromtoDerive τ (suc (suc n)) t (da • a1 • dρ) (a1 • ρ1) (a2 • ρ2) {! daa v• dρρ!}
--   -- fromtoDerive τ n t (da • a1 • dρ) (a1 • ρ1) (a2 • ρ2) {! daa v• dρρ!}

{-# OPTIONS --allow-unsolved-metas #-}
module Thesis.BigStep where

open import Data.Empty
open import Data.Unit
open import Relation.Binary.PropositionalEquality
open import Relation.Binary hiding (_⇒_)
open import Data.Nat using (ℕ; zero; suc; decTotalOrder; _<_)

open import Thesis.Syntax hiding (suc)
open import Thesis.Lang hiding (⟦_⟧Context; ⟦_⟧Var; suc)

-- open import Base.Syntax.Context Type public
-- open import Base.Syntax.Vars Type public

-- data Const : (τ : Type) → Set where
--   lit : ℤ → Const int
--   -- succ : Const (int ⇒ int)

-- data Term (Γ : Context) :
--   (τ : Type) → Set where
--   -- constants aka. primitives
--   const : ∀ {τ} →
--     (c : Const τ) →
--     Term Γ τ
--   var : ∀ {τ} →
--     (x : Var Γ τ) →
--     Term Γ τ
--   app : ∀ {σ τ}
--     (s : Term Γ (σ ⇒ τ)) →
--     (t : Term Γ σ) →
--     Term Γ τ
--   -- we use de Bruijn indices, so we don't need binding occurrences.
--   abs : ∀ {σ τ}
--     (t : Term (σ • Γ) τ) →
--     Term Γ (σ ⇒ τ)

data Val : Type → Set
open import Base.Denotation.Environment Type Val public
open import Base.Data.DependentList public

data Val where
  closure : ∀ {Γ σ τ} → (t : Term (σ • Γ) τ) → (ρ : ⟦ Γ ⟧Context) → Val (σ ⇒ τ)
  intV : ∀ (n : ℤ) → Val int
  -- prim : ∀ {σ τ} → (f : Val σ → Val τ) → Val (σ ⇒ τ)
  -- prim : ∀ {σ τ} → (f : ⟦ σ ⇒ τ ⟧Type) → Val (σ ⇒ τ)
  pairV : ∀ {σ τ} → Val σ → Val τ → Val (pair σ τ)
  -- prim : ∀ {σ τ} → (f : ⟦ σ ⟧Type → Val τ) → Val (σ ⇒ τ)

-- TODO: add defunctionalized interpretations for primitives. Yes, annoying but mechanical.

-- Doesn't work
-- data Val2 : ℕ → Type → Set where
--   prim : ∀ {σ τ n} → (f : Val2 n σ → Val2 n τ) → Val2 (ℕ.suc n) (σ ⇒ τ)

import Base.Denotation.Environment
-- Den stands for Denotational semantics.
module Den = Base.Denotation.Environment Type ⟦_⟧Type

⟦_⟧Val : ∀ {τ} → Val τ → ⟦ τ ⟧Type
⟦_⟧Env : ∀ {Γ} → ⟦ Γ ⟧Context → Den.⟦ Γ ⟧Context

⟦ ∅ ⟧Env = ∅
⟦ v • ρ ⟧Env = ⟦ v ⟧Val • ⟦ ρ ⟧Env

⟦ closure t ρ ⟧Val = λ v → (⟦ t ⟧Term) (v • ⟦ ρ ⟧Env)
⟦ intV n ⟧Val = n
-- ⟦ prim f ⟧Val = λ v → ⟦ f v ⟧Val
⟦ pairV a b ⟧Val = (⟦ a ⟧Val , ⟦ b ⟧Val)
-- ⟦ true ⟧Val = true
-- ⟦ false ⟧Val = false

↦-sound : ∀ {Γ τ} ρ (x : Var Γ τ) →
  Den.⟦ x ⟧Var ⟦ ρ ⟧Env ≡ ⟦ ⟦ x ⟧Var ρ ⟧Val
↦-sound (px • ρ) this = refl
↦-sound (px • ρ) (that x) = ↦-sound ρ x

--
-- Functional big-step semantics
--

-- Termination is far from obvious to Agda once we use closures. So we use
-- step-indexing with a fuel value, following "Type Soundness Proofs with
-- Definitional Interpreters". Since we focus for now on STLC, unlike that
-- paper, we can avoid error values by keeping types.
--
-- One could drop types and add error values, to reproduce what they do.

data ErrVal (τ : Type) : Set where
  Done : (v : Val τ) → ErrVal τ
  TimeOut : ErrVal τ

Res : Type → Set
Res τ = ℕ → ErrVal τ

evalConst : ∀ {τ} → Const τ → Res τ
evalConst (lit v) n = Done (intV v)
evalConst c n = {!!}

-- evalConst plus n = Done (prim (λ a → prim (λ b → intV (a + b))))
-- evalConst minus n = Done (prim (λ a → prim (λ b → intV (a - b))))
-- evalConst cons n = Done (prim (λ a → prim (λ b → {!pairV !})))
-- evalConst fst n = {!!}
-- evalConst snd n = {!!}
-- evalConst linj n = {!!}
-- evalConst rinj n = {!!}
-- evalConst match n = {!!}
-- evalConst zero = intV (+ 0)
-- evalConst succ = {!!}

eval : ∀ {Γ τ} → Term Γ τ → ⟦ Γ ⟧Context → Res τ

apply : ∀ {σ τ} → Val (σ ⇒ τ) → Val σ → Res τ
apply (closure t ρ) a n = eval t (a • ρ) n
-- apply (prim f) a n = Done (f ⟦ a ⟧Val)

eval t ρ zero = TimeOut
eval (const c) ρ (suc n) = evalConst c n
eval (var x) ρ (suc n) = Done (⟦ x ⟧Var ρ)
eval (abs t) ρ (suc n) = Done (closure t ρ)
eval (app s t) ρ (suc n) with eval s ρ n | eval t ρ n
... | Done f | Done a = apply f a n
... | _ | _ = TimeOut
-- eval t0 ρ (suc n) with t0
-- ... | const c = evalConst c n
-- ... | var x = Done (⟦ x ⟧Var ρ)
-- ... | abs t = Done (closure t ρ)
-- ... | app s t with eval s ρ n | eval t ρ n
-- ... | Done f | Done a = apply f a n
-- ... | _ | _ = TimeOut

-- Can we prove eval sound wrt. our reference denotational semantics? Yes! Very
-- cool!
eval-sound : ∀ {Γ τ} ρ v n (t : Term Γ τ) →
  eval t ρ n ≡ Done v →
  ⟦ t ⟧Term ⟦ ρ ⟧Env ≡ ⟦ v ⟧Val

apply-sound : ∀ {Γ σ τ} ρ v f a n (s : Term Γ (σ ⇒ τ)) t →
  ⟦ s ⟧Term ⟦ ρ ⟧Env ≡ ⟦ f ⟧Val →
  ⟦ t ⟧Term ⟦ ρ ⟧Env ≡ ⟦ a ⟧Val →
  apply f a n ≡ Done v →
  ⟦ s ⟧Term ⟦ ρ ⟧Env (⟦ t ⟧Term ⟦ ρ ⟧Env) ≡ ⟦ v ⟧Val
apply-sound _ v (closure ft ρ) a n s t feq aeq eq rewrite feq | aeq = eval-sound (a • ρ) v n ft eq

eval-sound ρ v zero t ()
eval-sound ρ v (ℕ.suc n) (const c) eq = {!!}
eval-sound ρ v (ℕ.suc n) (var x) refl = ↦-sound ρ x
eval-sound ρ v (ℕ.suc n) (abs t) refl = refl
eval-sound ρ v (ℕ.suc n) (app s t) eq with eval s ρ n | inspect (eval s ρ) n | eval t ρ n | inspect (eval t ρ) n
eval-sound ρ v (ℕ.suc n) (app s t) eq | Done f | [ feq ] | Done a | [ aeq ] =
  let feq = eval-sound ρ f n s feq; aeq = eval-sound ρ a n t aeq in apply-sound ρ v f a n s t feq aeq eq
eval-sound ρ v (ℕ.suc n) (app s t) () | Done f | _ | TimeOut | _
eval-sound ρ v (ℕ.suc n) (app s t) () | TimeOut | _ | _ | _
-- eval-sound n (const c) eq = {!!}
-- eval-sound n (var x) eq = {!!}
-- eval-sound n (app s t) eq = {!!} -- with eval s ρ n
-- eval-sound n (abs t) eq = {!!}
-- eval-sound n (const c) eq = {!!}
-- eval-sound n (var x) eq = {!!}
-- eval-sound n (app s t) eq = {!!} -- with eval s ρ n
-- eval-sound n (abs t) eq = {!!}

-- Next, we can try defining change structures and validity.

dapply : ∀ {σ τ} → Val (Δt (σ ⇒ τ)) → Val σ → Val (Δt σ) → Res (Δt τ)
dapply df a1 da zero = TimeOut
dapply df a1 da (suc zero) = TimeOut
dapply df a1 da (suc (suc n)) with apply df a1 n
... | Done dfa = apply dfa da (suc n)
... | TimeOut = TimeOut

-- apply (closure (abs (derive t)) dρ) a1 (suc (suc n))
-- eval (derive (abs t)) dρ (suc n) ≡
-- dapply-sound-0
--   dapply (closure (abs (derive t)) dρ) a1 da (suc n) ≡
--   eval (derive t) (da • a1 • dρ) n

dapply' : ∀ {σ τ} → ErrVal (Δt (σ ⇒ τ)) → ErrVal σ → ErrVal (Δt σ) → Res (Δt τ)
dapply' (Done df) (Done v) (Done dv) n = dapply df v dv n
dapply' _ _ _ _ = TimeOut

-- Which step-indexes should we use in dapply's specification and
-- implementation? That's highly non-obvious. To come up with them, I had to
-- step through the evaluation of eval (app (app ds t) dt), and verify that I
-- never invoke eval or apply on the same inputs at different step-indexes.
--
-- However, I expect I wouldn't be able to get a working proof if I got the
-- indexes wrong.
dapply-sound : ∀ {Γ σ τ} n ρ (ds : Term Γ (Δt (σ ⇒ τ))) t dt →
    eval (app (app ds t) dt) ρ (suc (suc n))
  ≡
    dapply' (eval ds ρ n) (eval t ρ n) (eval dt ρ (suc n)) (suc (suc n))
dapply-sound zero ρ ds t dt = refl
dapply-sound (suc n) ρ ds t dt with
  eval ds ρ (suc n) | eval t ρ (suc n) | eval dt ρ (suc (suc n))
dapply-sound (suc n) ρ ds t dt | Done df | Done v | Done dv with apply df v (suc n)
... | Done dfv = refl
... | TimeOut  = refl
dapply-sound (suc n) ρ ds t dt | Done df | Done v | TimeOut with apply df v (suc n)
... | Done dfv = refl
... | TimeOut = refl
dapply-sound (suc n) ρ ds t dt | Done df | TimeOut | dv = refl
dapply-sound (suc n) ρ ds t dt | TimeOut | v | dv = refl

ΔΓ : Context → Context
ΔΓ ∅ = ∅
ΔΓ (τ • Γ) = Δt τ • τ • ΔΓ Γ

ChΓ : ∀ (Γ : Context) → Set
ChΓ Γ = ⟦ ΔΓ Γ ⟧Context
Γ≼ΔΓ : ∀ {Γ} → Γ ≼ ΔΓ Γ
Γ≼ΔΓ {∅} = ∅
Γ≼ΔΓ {τ • Γ} = drop Δt τ • keep τ • Γ≼ΔΓ

fit : ∀ {τ Γ} → Term Γ τ → Term (ΔΓ Γ) τ
fit = weaken Γ≼ΔΓ

deriveConst : ∀ {τ} →
  Const τ →
  Term ∅ (Δt τ)
deriveConst = {!!}

derive-var : ∀ {Γ τ} → Var Γ τ → Var (ΔΓ Γ) (Δt τ)
derive-var this = this
derive-var (that x) = that (that (derive-var x))

derive : ∀ {Γ τ} → Term Γ τ → Term (ΔΓ Γ) (Δt τ)
derive (const c) = weaken (∅≼Γ {ΔΓ _}) (deriveConst c)
derive (var x) = var (derive-var x)
derive (app s t) = app (app (derive s) (fit t)) (derive t)
derive (abs t) = abs (abs (derive t))

-- open import Thesis.Derive
Chτ : Type → Set
Chτ τ = Val (Δt τ)

deval : ∀ {Γ τ} → (t : Term Γ τ) → (ρ : ⟦ Γ ⟧Context) (dρ : ChΓ Γ) → Res (Δt τ)
deval t ρ dρ = eval (derive t) dρ

dapply-equiv : ∀ {Γ σ τ} n
  (t : Term (σ • Γ) τ)
  (dρ : ChΓ Γ) (ρ1 : ⟦ Γ ⟧Context)
  (da : Val (Δt σ)) (a1 : Val σ) →
  dapply (closure (abs (derive t)) dρ) a1 da (suc (suc (suc n))) ≡
  eval (derive t) (da • a1 • dρ) (suc (suc n))
dapply-equiv n t dρ ρ1 da a1 = refl

-- Target statement:

_[_]τ_from_to_ : (n : ℕ) → ∀ τ → Val (Δt τ) → Val τ → Val τ → Set
_[_]τ'_from_to_ : (n : ℕ) → ∀ τ → ErrVal (Δt τ) → ErrVal τ → ErrVal τ → Set
n [ τ ]τ' Done dv from Done v1 to Done v2 = n [ τ ]τ dv from v1 to v2
n [ τ ]τ' TimeOut from Done v1 to Done v2 = ⊥
n [ τ ]τ' dv from _ to _ = ⊤

-- XXX: This is a lie for now, but all papers agree we'll want this in the end.
_[_]τmono_from_to : (n : ℕ) → ∀ τ → (dv : Val (Δt τ)) →
  ∀ v1 v2 n' →
  n' < n →
  n [ τ ]τ dv from v1 to v2 →
  n' [ τ ]τ dv from v1 to v2
_[_]τmono_from_to = {!!}

_[_]τ'_fromToTimeOut : ∀ n τ edv → n [ τ ]τ' edv from TimeOut to TimeOut ≡ ⊤
n [ τ ]τ' Done v fromToTimeOut = refl
n [ τ ]τ' TimeOut fromToTimeOut = refl
-- n [ τ ]τ' dv from Done v1 to TimeOut = ⊤
-- n [ τ ]τ' dv from TimeOut to Done v2 = ⊤
-- n [ τ ]τ' dv from TimeOut to TimeOut = ⊤

-- In the static-caching paper, the specification we use is similar to this one:
-- n [ σ ⇒ τ ]τ df from f1 to f2 = ∀ (da : Val (Δt σ)) → (a1 a2 : Val σ) →
--    n [ σ ]τ da from a1 to a2 →
--    ∀ v1 v2 → apply f1 a1 n ≡ Done v1 → apply f2 a2 n ≡ Done v2 →
--    Σ[ dv ∈ Val (Δt τ) ]
--        dapply df a1 da n ≡ Done dv
--      × n [ τ ]τ dv from v1 to v2
-- I defined _[_]τ'_from_to_ to be able to write an equivalent (hopefully) specification more quickly.

zero [ τ ]τ dv from v1 to v2 = ⊤
-- suc n [ σ ⇒ τ ]τ df from f1 to f2 =
--   ∀ (da : Val (Δt σ)) → (a1 a2 : Val σ) →
--    n [ σ ]τ da from a1 to a2 →
--    n [ τ ]τ' dapply df a1 da n from apply f1 a1 n to apply f2 a2 n

suc n [ σ ⇒ τ ]τ df from f1 to f2 = ∀ (da : Val (Δt σ)) → (a1 a2 : Val σ) →
   suc n [ σ ]τ da from a1 to a2 →

-- This definition violates all tips from Pitts tutorial (Step-Indexed
-- Biorthogonality: a Tutorial Example). Compare with Definition 4.1,
-- equation (10), and remark 4.4.
--
-- For extra complication, the setting is rather different, so a direct
-- comparison doesn't quite work.
   ∀ v1 v2 → apply f1 a1 (suc n) ≡ Done v1 → apply f2 a2 (suc n) ≡ Done v2 →
   Σ[ dv ∈ Val (Δt τ) ]
       dapply df a1 da (suc (suc n)) ≡ Done dv
     × n [ τ ]τ dv from v1 to v2

suc n [ int ]τ intV dn from intV n1 to intV n2 = n1 + dn ≡ n2
suc n [ pair σ τ ]τ pairV da db from pairV a1 b1 to pairV a2 b2 =
  suc n [ σ ]τ da from a1 to a2 × suc n [ τ ]τ db from b1 to b2
suc n [ sum σ τ ]τ () from v1 to v2

data _[_]Γ_from_to_ : ∀ ℕ Γ → ChΓ Γ → (ρ1 ρ2 : ⟦ Γ ⟧Context) → Set where
  v∅ : ∀ {n} → n [ ∅ ]Γ ∅ from ∅ to ∅
  _v•_ : ∀ {n τ Γ dv v1 v2 dρ ρ1 ρ2} →
    (dvv : n [ τ ]τ dv from v1 to v2) →
    (dρρ : n [ Γ ]Γ dρ from ρ1 to ρ2) →
    n [ τ • Γ ]Γ (dv • v1 • dρ) from (v1 • ρ1) to (v2 • ρ2)

fromtoDeriveVar : ∀ {Γ} τ n → (x : Var Γ τ) →
  (dρ : ChΓ Γ) (ρ1 ρ2 : ⟦ Γ ⟧Context) → n [ Γ ]Γ dρ from ρ1 to ρ2 →
    n [ τ ]τ (⟦ derive-var x ⟧Var dρ) from ⟦ x ⟧Var ρ1 to ⟦ x ⟧Var ρ2
fromtoDeriveVar τ n this (dv • .(v1 • _)) (v1 • ρ1) (v2 • ρ2) (dvv v• dρρ) = dvv
fromtoDeriveVar τ n (that x) (dv • (.v1 • dρ)) (v1 • ρ1) (v2 • ρ2) (dvv v• dρρ) = fromtoDeriveVar τ n x dρ ρ1 ρ2 dρρ

foo : ∀ {Γ σ τ v1 v2 dv} n (t : Term (σ • Γ) τ) →
  (dρ : ChΓ Γ) (ρ1 ρ2 : ⟦ Γ ⟧Context)
  (da : Val (Δt σ)) (a1 a2 : Val σ) →
  (eqv1 : eval t (a1 • ρ1) (suc (suc n)) ≡ Done v1) →
  (eqv2 : eval t (a2 • ρ2) (suc (suc n)) ≡ Done v2) →
  (eqvv : eval (derive t) (da • a1 • dρ) (suc (suc n)) ≡ Done dv) →
  suc (suc n) [ τ ]τ' eval (derive t) (da • a1 • dρ) (suc (suc n)) from
      eval t (a1 • ρ1) (suc (suc n)) to eval t (a2 • ρ2) (suc (suc n)) →
  suc n [ τ ]τ dv from v1 to v2
foo n t dρ ρ1 ρ2 da a1 a2 eqv1 eqv2 eqvv dvv with eval t (a1 • ρ1) (suc (suc n)) | eval t (a2 • ρ2) (suc (suc n)) | eval (derive t) (da • a1 • dρ) (suc (suc n))
foo n t dρ ρ1 ρ2 da a1 a2 refl refl refl dvv | Done v1 | (Done v2) | (Done dv) = _[_]τmono_from_to (suc (suc n)) _ dv v1 v2 (suc n) (DecTotalOrder.reflexive Data.Nat.decTotalOrder refl) dvv
foo n t dρ ρ1 ρ2 da a1 a2 refl refl () dvv | Done v₁ | (Done v) | TimeOut
foo n t dρ ρ1 ρ2 da a1 a2 refl () eqvv dvv | Done v | TimeOut | s
foo n t dρ ρ1 ρ2 da a1 a2 () eqv2 eqvv dvv | TimeOut | r | s
-- q r s eqv1 eqv2 eqvv

fromtoDerive : ∀ {Γ} τ n → (t : Term Γ τ) →
  (dρ : ChΓ Γ) (ρ1 ρ2 : ⟦ Γ ⟧Context) → n [ Γ ]Γ dρ from ρ1 to ρ2 →
    n [ τ ]τ' (deval t ρ1 dρ n) from eval t ρ1 n to eval t ρ2 n
fromtoDerive τ zero t dρ ρ1 ρ2 dρρ rewrite zero [ τ ]τ' (deval t ρ1 dρ (suc zero)) fromToTimeOut = tt
fromtoDerive τ (suc n) (const c) dρ ρ1 ρ2 dρρ = {!!}
fromtoDerive τ (suc n) (var x) dρ ρ1 ρ2 dρρ = fromtoDeriveVar τ (suc n) x dρ ρ1 ρ2 dρρ
fromtoDerive τ (suc n) (app s t) dρ ρ1 ρ2 dρρ = {!fromtoDerive _ (suc n) s dρ ρ1 ρ2 dρρ!}
-- fromtoDerive (σ ⇒ τ) (suc n) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa
--   rewrite dapply-equiv n t dρ ρ1 da a1 =
--   fromtoDerive τ (suc n) t (da • a1 • dρ) (a1 • ρ1) (a2 • ρ2) (daa v• dρρ)
fromtoDerive (σ ⇒ τ) (suc zero) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa v1 v2 eqv1 eqv2 = {!LIE!!}
fromtoDerive (σ ⇒ τ) (suc (suc n)) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa v1 v2 eqv1 eqv2 with
  eval (derive t) (da • a1 • dρ) (suc (suc n)) | inspect (eval (derive t) (da • a1 • dρ)) (suc (suc n))
fromtoDerive (σ ⇒ τ) (suc (suc n)) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa v1 v2 eqv1 eqv2 | Done dv | [ eqvv ] = dv , refl , foo n t  dρ ρ1 ρ2 da a1 a2 eqv1 eqv2 eqvv (fromtoDerive τ (suc (suc n)) t (da • a1 • dρ) (a1 • ρ1) (a2 • ρ2) (daa v• dρρ))
fromtoDerive (σ ⇒ τ) (suc (suc n)) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa v1 v2 eqv1 eqv2 | TimeOut | eq = {!LIE!!}
-- {!eval (derive t)!} , {!fromtoDerive τ (suc n) t (da • a1 • dρ) (a1 • ρ1) (a2 • ρ2) ?!}

-- fromtoDerive (σ ⇒ τ) (suc (suc zero)) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa = {!!}
-- fromtoDerive (σ ⇒ τ) (suc (suc (suc n))) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa
--   with eval (abs (derive t)) (a1 • dρ) n | inspect (eval (abs (derive t)) (a1 • dρ)) n
-- fromtoDerive (σ ⇒ τ) (suc (suc (suc n))) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa | Done v | [ eq ] = {!fromtoDerive τ (suc (suc n)) t (da • a1 • dρ) (a1 • ρ1) (a2 • ρ2) _!}
-- fromtoDerive (σ ⇒ τ) (suc (suc (suc n))) (abs t) dρ ρ1 ρ2 dρρ da a1 a2 daa | TimeOut | _ = {!!}
-- --   fromtoDerive τ n t (da • a1 • dρ) (a1 • ρ1) (a2 • ρ2) (daa v• ?)
-- -- fromtoDerive τ (suc (suc n)) t (da • a1 • dρ) (a1 • ρ1) (a2 • ρ2) {! daa v• dρρ!}
--   -- fromtoDerive τ n t (da • a1 • dρ) (a1 • ρ1) (a2 • ρ2) {! daa v• dρρ!}


README

README

module README where

open import Explore.README

open import Game.DDH
open import Game.IND-CPA
open import Game.EntropySmoothing
open import Game.EntropySmoothing.WithKey
open import Game.Transformation.InternalExternal

open import Crypto.Schemes
open import Cipher.ElGamal.Generic

open import Solver.Linear
open import Solver.AddMax

open import FunUniverse.README

open import bijection-syntax.README

open import alea.cpo

open import circuits.circuit

open import Composition.Horizontal
open import Composition.Vertical
open import Composition.Forkable

module README where

open import Game.DDH
open import Game.IND-CPA
open import Game.EntropySmoothing
open import Game.EntropySmoothing.WithKey
open import Game.Transformation.InternalExternal

open import Crypto.Schemes
open import Cipher.ElGamal.Generic

open import Solver.Linear
open import Solver.AddMax

open import FunUniverse.README

open import bijection-syntax.README

--open import alea.cpo

open import circuits.circuit

open import Composition.Horizontal
open import Composition.Vertical
open import Composition.Forkable


Bijection.NP

Bijection.NP

{-# OPTIONS --without-K #-}
module Function.Bijection.NP where

open import Function.Bijection public
open import Function.Surjection
open import Function.Equality hiding (flip)
open import Relation.Binary
open import Data.Product
open import Level

_⟨$⟩₁_ : ∀ {f₁ f₂ t₁ t₂}
           {From : Setoid f₁ f₂} {To : Setoid t₁ t₂}
         → Bijection From To → Setoid.Carrier From → Setoid.Carrier To
_⟨$⟩₁_ bij x = Bijection.to bij ⟨$⟩ x

_⟨$⟩₂_ : ∀ {f₁ f₂ t₁ t₂}
           {From : Setoid f₁ f₂} {To : Setoid t₁ t₂}
         → Bijection From To → Setoid.Carrier To → Setoid.Carrier From
_⟨$⟩₂_ bij x = Bijection.from bij ⟨$⟩ x

_∈_ : ∀  {a₁ a₂}
         {A₁ A₂  : Setoid a₁ a₂}
         (xᵢ     : Setoid.Carrier A₁ × Setoid.Carrier A₂)
         (bij    : Bijection A₁ A₂)
      →  Set a₂
_∈_ {A₂ = A₂} (x₁ , x₂) bij = bij ⟨$⟩₁ x₁ ≈ x₂
  where open Setoid A₂

-- Bijection is symmetric
flip : ∀ {f₁ f₂ t₁ t₂} {From : Setoid f₁ f₂} {To : Setoid t₁ t₂}
       → Bijection From To → Bijection To From
flip bij =
  record { to = from
         ; bijective =
             record { injective = Surjection.injective surjection
                    ; surjective =
                        record { from = to
                               ; right-inverse-of = left-inverse-of } } }
  where open Bijection bij

{-# OPTIONS --without-K #-}
{-# OPTIONS --universe-polymorphism #-}
module Function.Bijection.NP where

open import Function.Bijection public
open import Function.Surjection
open import Function.Equality
open import Relation.Binary
open import Data.Product
open import Level

_⟨$⟩₁_ : ∀ {f₁ f₂ t₁ t₂}
           {From : Setoid f₁ f₂} {To : Setoid t₁ t₂}
         → Bijection From To → Setoid.Carrier From → Setoid.Carrier To
_⟨$⟩₁_ bij x = Bijection.to bij ⟨$⟩ x

_⟨$⟩₂_ : ∀ {f₁ f₂ t₁ t₂}
           {From : Setoid f₁ f₂} {To : Setoid t₁ t₂}
         → Bijection From To → Setoid.Carrier To → Setoid.Carrier From
_⟨$⟩₂_ bij x = Bijection.from bij ⟨$⟩ x

_∈_ : ∀  {a₁ a₂}
         {A₁ A₂  : Setoid a₁ a₂}
         (xᵢ     : Setoid.Carrier A₁ × Setoid.Carrier A₂)
         (bij    : Bijection A₁ A₂)
      →  Set a₂
_∈_ {A₂ = A₂} (x₁ , x₂) bij = bij ⟨$⟩₁ x₁ ≈ x₂
  where open Setoid A₂

-- Bijection is symmetric
flip : ∀ {f₁ f₂ t₁ t₂} {From : Setoid f₁ f₂} {To : Setoid t₁ t₂}
       → Bijection From To → Bijection To From
flip bij =
  record { to = from
         ; bijective =
             record { injective = Surjection.injective surjection
                    ; surjective =
                        record { from = to
                               ; right-inverse-of = left-inverse-of } } }
  where open Bijection bij

{-
wip : ∀  {a₁ a₂}
         {A₁ A₂  : Setoid a₁ a₂}
         (xᵢ     : Setoid.Carrier A₁ × Setoid.Carrier A₂)
         (bij    : Bijection A₁ A₂)
      → xᵢ ∈ bij → swap xᵢ ∈ flip bij
wip (x₁ , x₂) bij x = ?
-}


Before changing the nextComs to comply with the new definitions of reverseTran, indRevNoComs functions

{-# OPTIONS --exact-split #-}
module IndexLFCo where

open import Common
open import LinLogic
open import LinLogicProp
open import LinFun
open import IndexLLProp
open import Data.Maybe

module _ where

  open import Relation.Binary.PropositionalEquality using (sym)
  open  Relation.Binary.PropositionalEquality.Deprecated-inspect

  -- reverseTran returns nothing if during the reversion, it finds a com.
  -- or if the cll is transformed.

  mutual
    data ReverseTranT {i u} : ∀{ll cll rll} → LFun ll rll → IndexLL {i} {u} cll rll → Set u where
      cr1 : ∀{cll rll} → {iind : IndexLL {i} {u} cll rll} → ReverseTranT I iind
      cr2 : ∀{ll cll rll ell pll ind lf₁ lf x₁} → {iind : IndexLL {i} {u} cll rll} → (rvT₁ : ReverseTranT lf₁ iind) → let x = reverseTran lf₁ iind rvT₁ in (just x₁ ≡ x -ₘᵢ (updInd ell ind)) → (rvT₂ : ReverseTranT lf x₁) → ReverseTranT (_⊂_ {pll = pll} {ll = ll} {ell = ell} {rll = rll} {ind = ind} lf lf₁) iind
      cr3 : ∀{ll cll rll ell pll ind lf₁ lf} → {iind : IndexLL {i} {u} cll rll} → (rvT₁ : ReverseTranT lf₁ iind) → let x = reverseTran lf₁ iind rvT₁ in (eq₁ : (x -ₘᵢ (updInd ell ind) ≡ nothing)) → (eq₂ :((updInd ell ind) -ₘᵢ x ≡ nothing)) → ReverseTranT (_⊂_ {pll = pll} {ll = ll} {ell = ell} {rll = rll} {ind = ind} lf lf₁) iind
      cr4 : ∀{ll cll orll rll lf x} → {ltr : LLTr orll ll} → {iind : IndexLL {i} {u} cll rll} → (rvT₁ : ReverseTranT lf iind) → (just x ≡ tran (reverseTran lf iind rvT₁) (revTr ltr)) → ReverseTranT (tr ltr lf) iind

    -- reverseTran returns nothing if during the reversion, it finds a com.
    -- or if the cll is transformed.

    reverseTran : ∀{i u ll cll rll} → (lf : LFun ll rll) → (iind : IndexLL {i} {u} cll rll) → ReverseTranT lf iind → IndexLL cll ll
    reverseTran .I iind cr1 = iind
    reverseTran (_⊂_ {ind = ind} lf lf₁) iind (cr2 {x₁ = x₁} pr x pr₁) =  ind +ᵢ (reverseTran lf x₁ pr₁)
    reverseTran (_⊂_ {ind = ind} _ lf₁) iind (cr3 pr eq₁ eq₂) = revUpdInd ind (reverseTran lf₁ iind pr) eq₁ eq₂
    reverseTran (tr ltr lf) iind (cr4 {x = x} pr eq) = x

  getReverseTranT : ∀{i u ll cll rll} → (lf : LFun ll rll) → (iind : IndexLL {i} {u} cll rll) → Maybe $ ReverseTranT lf iind
  getReverseTranT I iind = just cr1
  getReverseTranT (_⊂_ {ell = ell} {ind = ind} lf lf₁) iind with (getReverseTranT lf₁ iind)
  getReverseTranT (_⊂_ {_} {_} {ell} {_} {ind} lf lf₁) iind | just x with (inspect ((reverseTran lf₁ iind x) -ₘᵢ (updInd ell ind)))
  getReverseTranT (_⊂_ {_} {_} {ell} {_} {ind} lf lf₁) iind | just x | ((just x₁) with-≡ eq) with (getReverseTranT lf x₁)
  getReverseTranT (_⊂_ {pll} {ll} {ell} {rll} {ind} lf lf₁) iind | just x | (just x₁ with-≡ eq) | (just x₂) = just (cr2 x (sym eq) x₂)
  getReverseTranT (_⊂_ {_} {_} {ell} {_} {ind} lf lf₁) iind | just x | (just x₁ with-≡ eq) | nothing = nothing
  getReverseTranT (_⊂_ {_} {_} {ell} {_} {ind} lf lf₁) iind | just x | (nothing with-≡ eq) with (inspect ((updInd ell ind) -ₘᵢ (reverseTran lf₁ iind x)))
  getReverseTranT (_⊂_ {_} {_} {ell} {_} {ind} lf lf₁) iind | just x | (nothing with-≡ eq) | (just x₁ with-≡ eq₁) = nothing -- We do not accept transformations that change the cll. The cll definitely changes here. (unless lf only has iind).
  getReverseTranT (_⊂_ {_} {_} {ell} {_} {ind} lf lf₁) iind | just x | (nothing with-≡ eq) | (nothing with-≡ eq₁) = just (cr3 x eq eq₁)
  getReverseTranT (_⊂_ {_} {_} {ell} {_} {ind} lf lf₁) iind | nothing = nothing
  getReverseTranT (tr ltr lf) iind with (getReverseTranT lf iind)
  getReverseTranT (tr ltr lf) iind | just x with (inspect (tran (reverseTran lf iind x) (revTr ltr)))
  getReverseTranT (tr ltr lf) iind | just x | (just x₁ with-≡ eq) = just (cr4 x (sym eq))
  getReverseTranT (tr ltr lf) iind | just x | (nothing with-≡ eq) = nothing
  getReverseTranT (tr ltr lf) iind | nothing = nothing
  getReverseTranT (com df lf) iind = nothing
  getReverseTranT (call x) iind = nothing

  data IndRevNoComsT {i u ll pll ell cll} {ind : IndexLL {i} {u} pll ll} {lind : IndexLL cll (replLL ll ind ell)} {lf : LFun pll ell} : Set u where
    c1 : ∀{x} → (just x ≡ lind -ₘᵢ (updInd ell ind)) → (ReverseTranT lf x) → IndRevNoComsT
    c2 : (lind -ₘᵢ (updInd ell ind) ≡ nothing) → ((updInd ell ind) -ₘᵢ lind ≡ nothing) → IndRevNoComsT

  indRevNoComs : ∀{i u ll pll ell cll} → (ind : IndexLL {i} {u} pll ll) → (lind : IndexLL cll (replLL ll ind ell)) → (lf : LFun pll ell) → IndRevNoComsT {ind = ind} {lind = lind} {lf = lf} → IndexLL cll ll
  indRevNoComs ind lind lf (c1 {x = x} b pr) = ind +ᵢ (reverseTran lf x pr)
  indRevNoComs ind lind lf (c2 eq₁ eq₂) = revUpdInd ind lind eq₁ eq₂

-- This is almost the same code as above but it is required in IndexLFCo.
  getIndRevNoComsT : ∀{i u ll pll ell cll} → (ind : IndexLL {i} {u} pll ll) → (lind : IndexLL cll (replLL ll ind ell)) → (lf : LFun pll ell) → Maybe $ IndRevNoComsT {ind = ind} {lind = lind} {lf = lf}
  getIndRevNoComsT {ell = ell} ind lind lf with (inspect (lind -ₘᵢ (updInd ell ind)))
  getIndRevNoComsT {_} {_} {_} {_} {ell} ind lind lf | just x with-≡ eq with (getReverseTranT lf x)
  getIndRevNoComsT {_} {_} {_} {_} {ell} ind lind lf | just x with-≡ eq | (just x₁) = just (c1 (sym eq) x₁)
  getIndRevNoComsT {_} {_} {_} {_} {ell} ind lind lf | just x with-≡ eq | nothing = nothing
  getIndRevNoComsT {_} {_} {_} {_} {ell} ind lind lf | nothing with-≡ eq with (inspect ((updInd ell ind) -ₘᵢ lind))
  getIndRevNoComsT {_} {_} {_} {_} {ell} ind lind lf | nothing with-≡ eq | (just x with-≡ eq₁) = nothing
  getIndRevNoComsT {_} {_} {_} {_} {ell} ind lind lf | nothing with-≡ eq | (nothing with-≡ eq₁) = just (c2 eq eq₁)

data IndexLFCo {i u cll} (frll : LinLogic i {u}) : ∀{ll rll} → IndexLL cll ll → LFun {i} {u} ll rll → Set (u) where
  _←⊂ : ∀{rll pll ell ll ind elf lf lind}
         → IndexLFCo frll lind elf
         → IndexLFCo frll (ind +ᵢ lind) (_⊂_ {i} {u} {pll} {ll} {ell} {rll} {ind} elf lf)
  ⊂→_ : ∀{rll pll ell ll ind elf lf lind rs}
         → IndexLFCo frll lind lf
         → (irnc : IndRevNoComsT {ind = ind} {lind = lind} {lf = elf})
         → {prf : rs ≡ indRevNoComs ind lind elf irnc}
         → IndexLFCo frll rs (_⊂_ {i} {u} {pll} {ll} {ell} {rll} {ind} elf lf)
  tr   : ∀{ll orll rll lind rs} → {ltr : LLTr orll ll} → {lf : LFun {i} {u} orll rll}
         → IndexLFCo frll lind lf
         → {prf : just rs ≡ tran lind (revTr ltr) }
         → IndexLFCo frll rs (tr ltr lf)
  ↓  : ∀{rll prfi prfo df lf}
         → IndexLFCo  frll ↓ (com {i} {u} {rll} {cll} {frll} {{prfi}} {{prfo}} df lf)

data SetLFCoRem {i u oll orll} (olf : LFun {i} {u} oll orll) : LinLogic i {u} → Set (lsuc u) where
  ↓    : ∀{ll cll frll} → {ind : IndexLL {i} {u} cll oll} → IndexLFCo frll ind olf → SetLFCoRem olf ll
  _←∧   : ∀{rs ls} → SetLFCoRem olf ls                   → SetLFCoRem olf (ls ∧ rs)
  ∧→_   : ∀{rs ls} → SetLFCoRem olf rs                   → SetLFCoRem olf (ls ∧ rs)
  _←∧→_ : ∀{rs ls} → SetLFCoRem olf ls → SetLFCoRem olf rs → SetLFCoRem olf (ls ∧ rs)
  _←∨   : ∀{rs ls} → SetLFCoRem olf ls                   → SetLFCoRem olf (ls ∨ rs)
  ∨→_   : ∀{rs ls} → SetLFCoRem olf rs                   → SetLFCoRem olf (ls ∨ rs)
  _←∨→_ : ∀{rs ls} → SetLFCoRem olf ls → SetLFCoRem olf rs → SetLFCoRem olf (ls ∨ rs)
  _←∂   : ∀{rs ls} → SetLFCoRem olf ls                   → SetLFCoRem olf (ls ∂ rs)
  ∂→_   : ∀{rs ls} → SetLFCoRem olf rs                   → SetLFCoRem olf (ls ∂ rs)
  _←∂→_ : ∀{rs ls} → SetLFCoRem olf ls → SetLFCoRem olf rs → SetLFCoRem olf (ls ∂ rs)

data MSetLFCoRem {i u oll orll} (olf : LFun {i} {u} oll orll) : LinLogic i {u} → Set (lsuc u) where
  ∅   : ∀{ll}            → MSetLFCoRem olf ll
  ¬∅  : ∀{ll} → SetLFCoRem olf ll → MSetLFCoRem olf ll

∅-addLFCoRem : ∀{i u ll pll oll orll frll cll} → {iind : IndexLL cll oll} → {olf : LFun {i} {u} oll orll} → (ind : IndexLL {i} {u} pll ll) → IndexLFCo frll iind olf
        → SetLFCoRem olf ll
∅-addLFCoRem ↓ m = ↓ m
∅-addLFCoRem (ind ←∧) m = (∅-addLFCoRem ind m) ←∧
∅-addLFCoRem (∧→ ind) m = ∧→ (∅-addLFCoRem ind m)
∅-addLFCoRem (ind ←∨) m = (∅-addLFCoRem ind m) ←∨
∅-addLFCoRem (∨→ ind) m = ∨→ (∅-addLFCoRem ind m)
∅-addLFCoRem (ind ←∂) m = (∅-addLFCoRem ind m) ←∂
∅-addLFCoRem (∂→ ind) m = ∂→ (∅-addLFCoRem ind m)

addLFCoRem : ∀{i u ll pll oll orll frll cll} → {iind : IndexLL cll oll} → {olf : LFun {i} {u} oll orll} → SetLFCoRem olf ll → (ind : IndexLL {i} {u} pll ll) → IndexLFCo frll iind olf
        → SetLFCoRem olf ll
addLFCoRem (↓ rm) ind m          = ↓ m
addLFCoRem (x ←∧) ↓ m            = ↓ m
addLFCoRem (∧→ x) ↓ m            = ↓ m --TODO Here we lose the information that is at lower levels.
addLFCoRem (x ←∧→ x₁) ↓ m        = ↓ m
addLFCoRem (x ←∨) ↓ m            = ↓ m
addLFCoRem (∨→ x) ↓ m            = ↓ m
addLFCoRem (x ←∨→ x₁) ↓ m        = ↓ m
addLFCoRem (x ←∂) ↓ m            = ↓ m
addLFCoRem (∂→ x) ↓ m            = ↓ m
addLFCoRem (x ←∂→ x₁) ↓ m        = ↓ m
addLFCoRem (s ←∧) (ind ←∧) m     = (addLFCoRem s ind m) ←∧
addLFCoRem (s ←∧) (∧→ ind) m     = s ←∧→ (∅-addLFCoRem ind m)
addLFCoRem (∧→ s) (ind ←∧) m     = (∅-addLFCoRem ind m) ←∧→ s
addLFCoRem (∧→ s) (∧→ ind) m     = ∧→ addLFCoRem s ind m
addLFCoRem (s ←∧→ s₁) (ind ←∧) m = (addLFCoRem s ind m) ←∧→ s₁
addLFCoRem (s ←∧→ s₁) (∧→ ind) m = s ←∧→ (addLFCoRem s₁ ind m)
addLFCoRem (s ←∨) (ind ←∨) m     = (addLFCoRem s ind m) ←∨
addLFCoRem (s ←∨) (∨→ ind) m     = s ←∨→ (∅-addLFCoRem ind m)
addLFCoRem (∨→ s) (ind ←∨) m     = (∅-addLFCoRem ind m) ←∨→ s
addLFCoRem (∨→ s) (∨→ ind) m     = ∨→ addLFCoRem s ind m
addLFCoRem (s ←∨→ s₁) (ind ←∨) m = (addLFCoRem s ind m) ←∨→ s₁
addLFCoRem (s ←∨→ s₁) (∨→ ind) m = s ←∨→ (addLFCoRem s₁ ind m)
addLFCoRem (s ←∂) (ind ←∂) m     = (addLFCoRem s ind m) ←∂
addLFCoRem (s ←∂) (∂→ ind) m     = s ←∂→ (∅-addLFCoRem ind m)
addLFCoRem (∂→ s) (ind ←∂) m     = (∅-addLFCoRem ind m) ←∂→ s
addLFCoRem (∂→ s) (∂→ ind) m     = ∂→ addLFCoRem s ind m
addLFCoRem (s ←∂→ s₁) (ind ←∂) m = (addLFCoRem s ind m) ←∂→ s₁
addLFCoRem (s ←∂→ s₁) (∂→ ind) m = s ←∂→ (addLFCoRem s₁ ind m)

maddLFCoRem : ∀{i u ll pll oll orll frll cll} → {iind : IndexLL cll oll} → {olf : LFun {i} {u} oll orll} → MSetLFCoRem olf ll → (ind : IndexLL {i} {u} pll ll) → IndexLFCo frll iind olf
      → MSetLFCoRem olf ll
maddLFCoRem ∅ ind m = ¬∅ (∅-addLFCoRem ind m)
maddLFCoRem (¬∅ x) ind m = ¬∅ (addLFCoRem x ind m)

truncSetLFCoRem : ∀{i} → ∀{u ll oll orll q} → {olf : LFun {i} {u} oll orll} → MSetLFCoRem {i} {u} olf ll → (ind : IndexLL {i} {u} q ll) → MSetLFCoRem {i} olf q
truncSetLFCoRem ∅ ind = ∅
truncSetLFCoRem (¬∅ x) ↓ = ¬∅ x
truncSetLFCoRem (¬∅ (↓ x)) (ind ←∧) = ∅
truncSetLFCoRem (¬∅ (x ←∧)) (ind ←∧) = truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (∧→ x)) (ind ←∧) = ∅
truncSetLFCoRem (¬∅ (x ←∧→ x₁)) (ind ←∧) = truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (↓ x)) (∧→ ind) = ∅
truncSetLFCoRem (¬∅ (x ←∧)) (∧→ ind) = ∅
truncSetLFCoRem (¬∅ (∧→ x)) (∧→ ind) =  truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (x ←∧→ x₁)) (∧→ ind) =  truncSetLFCoRem (¬∅ x₁) ind
truncSetLFCoRem (¬∅ (↓ x)) (ind ←∨) = ∅
truncSetLFCoRem (¬∅ (x ←∨)) (ind ←∨) = truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (∨→ x)) (ind ←∨) = ∅
truncSetLFCoRem (¬∅ (x ←∨→ x₁)) (ind ←∨) = truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (↓ x)) (∨→ ind) = ∅
truncSetLFCoRem (¬∅ (x ←∨)) (∨→ ind) = ∅
truncSetLFCoRem (¬∅ (∨→ x)) (∨→ ind) =  truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (x ←∨→ x₁)) (∨→ ind) =  truncSetLFCoRem (¬∅ x₁) ind
truncSetLFCoRem (¬∅ (↓ x)) (ind ←∂) = ∅
truncSetLFCoRem (¬∅ (x ←∂)) (ind ←∂) = truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (∂→ x)) (ind ←∂) = ∅
truncSetLFCoRem (¬∅ (x ←∂→ x₁)) (ind ←∂) = truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (↓ x)) (∂→ ind) = ∅
truncSetLFCoRem (¬∅ (x ←∂)) (∂→ ind) = ∅
truncSetLFCoRem (¬∅ (∂→ x)) (∂→ ind) =  truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (x ←∂→ x₁)) (∂→ ind) =  truncSetLFCoRem (¬∅ x₁) ind

delLFCoRem : ∀{i u oll orll ll pll} → {olf : LFun {i} {u} oll orll} → SetLFCoRem {i} olf ll → (ind : IndexLL {i} {u} pll ll) → (rll : LinLogic i)
      → MSetLFCoRem {i} olf (replLL ll ind rll)
delLFCoRem s ↓ rll = ∅
delLFCoRem (↓ x) (ind ←∧) rll = ∅ -- We loose Information.
delLFCoRem (s ←∧) (ind ←∧) rll with (delLFCoRem s ind rll)
delLFCoRem (s ←∧) (ind ←∧) rll | ∅ = ∅
delLFCoRem (s ←∧) (ind ←∧) rll | ¬∅ x = ¬∅ (x ←∧)
delLFCoRem (∧→ s) (ind ←∧) rll = ¬∅ (∧→ (s))
delLFCoRem (s ←∧→ s₁) (ind ←∧) rll with (delLFCoRem s ind rll)
delLFCoRem (s ←∧→ s₁) (ind ←∧) rll | ∅ = ¬∅ (∧→ (s₁))
delLFCoRem (s ←∧→ s₁) (ind ←∧) rll | ¬∅ x = ¬∅ (x ←∧→ (s₁))
delLFCoRem (↓ x) (∧→ ind) rll = ∅ --
delLFCoRem (s ←∧) (∧→ ind) rll = ¬∅ ((s) ←∧)
delLFCoRem (∧→ s) (∧→ ind) rll with (delLFCoRem s ind rll)
delLFCoRem (∧→ s) (∧→ ind) rll | ∅ = ∅
delLFCoRem (∧→ s) (∧→ ind) rll | ¬∅ x = ¬∅ (∧→ x)
delLFCoRem (s ←∧→ s₁) (∧→ ind) rll with (delLFCoRem s₁ ind rll)
delLFCoRem (s ←∧→ s₁) (∧→ ind) rll | ∅ = ¬∅ ((s) ←∧)
delLFCoRem (s ←∧→ s₁) (∧→ ind) rll | ¬∅ x = ¬∅ ((s) ←∧→ x)
delLFCoRem (↓ x) (ind ←∨) rll = ∅
delLFCoRem (s ←∨) (ind ←∨) rll with (delLFCoRem s ind rll)
delLFCoRem (s ←∨) (ind ←∨) rll | ∅ = ∅
delLFCoRem (s ←∨) (ind ←∨) rll | ¬∅ x = ¬∅ (x ←∨)
delLFCoRem (∨→ s) (ind ←∨) rll = ¬∅ (∨→ (s))
delLFCoRem (s ←∨→ s₁) (ind ←∨) rll with (delLFCoRem s ind rll)
delLFCoRem (s ←∨→ s₁) (ind ←∨) rll | ∅ = ¬∅ (∨→ (s₁))
delLFCoRem (s ←∨→ s₁) (ind ←∨) rll | ¬∅ x = ¬∅ (x ←∨→ (s₁))
delLFCoRem (↓ x) (∨→ ind) rll = ∅
delLFCoRem (s ←∨) (∨→ ind) rll = ¬∅ ((s) ←∨)
delLFCoRem (∨→ s) (∨→ ind) rll with (delLFCoRem s ind rll)
delLFCoRem (∨→ s) (∨→ ind) rll | ∅ = ∅
delLFCoRem (∨→ s) (∨→ ind) rll | ¬∅ x = ¬∅ (∨→ x)
delLFCoRem (s ←∨→ s₁) (∨→ ind) rll with (delLFCoRem s₁ ind rll)
delLFCoRem (s ←∨→ s₁) (∨→ ind) rll | ∅ = ¬∅ ((s) ←∨)
delLFCoRem (s ←∨→ s₁) (∨→ ind) rll | ¬∅ x = ¬∅ ((s) ←∨→ x)
delLFCoRem (↓ x) (ind ←∂) rll = ∅
delLFCoRem (s ←∂) (ind ←∂) rll with (delLFCoRem s ind rll)
delLFCoRem (s ←∂) (ind ←∂) rll | ∅ = ∅
delLFCoRem (s ←∂) (ind ←∂) rll | ¬∅ x = ¬∅ (x ←∂)
delLFCoRem (∂→ s) (ind ←∂) rll = ¬∅ (∂→ (s))
delLFCoRem (s ←∂→ s₁) (ind ←∂) rll with (delLFCoRem s ind rll)
delLFCoRem (s ←∂→ s₁) (ind ←∂) rll | ∅ = ¬∅ (∂→ (s₁))
delLFCoRem (s ←∂→ s₁) (ind ←∂) rll | ¬∅ x = ¬∅ (x ←∂→ (s₁))
delLFCoRem (↓ x) (∂→ ind) rll = ∅
delLFCoRem (s ←∂) (∂→ ind) rll = ¬∅ ((s) ←∂)
delLFCoRem (∂→ s) (∂→ ind) rll with (delLFCoRem s ind rll)
delLFCoRem (∂→ s) (∂→ ind) rll | ∅ = ∅
delLFCoRem (∂→ s) (∂→ ind) rll | ¬∅ x = ¬∅ (∂→ x)
delLFCoRem (s ←∂→ s₁) (∂→ ind) rll with (delLFCoRem s₁ ind rll)
delLFCoRem (s ←∂→ s₁) (∂→ ind) rll | ∅ = ¬∅ ((s) ←∂)
delLFCoRem (s ←∂→ s₁) (∂→ ind) rll | ¬∅ x = ¬∅ ((s) ←∂→ x)

mdelLFCoRem : ∀{i u oll orll ll pll} → {olf : LFun {i} {u} oll orll} → MSetLFCoRem {i} olf ll → (ind : IndexLL {i} {u} pll ll) → (rll : LinLogic i)
             → MSetLFCoRem {i} olf (replLL ll ind rll)
mdelLFCoRem ∅ ind rll = ∅
mdelLFCoRem (¬∅ x) ind rll = delLFCoRem x ind rll

tranLFCoRem : ∀{i u oll orll ll rll} → {olf : LFun {i} {u} oll orll} → SetLFCoRem {i} olf ll → (tr : LLTr {i} {u} rll ll)
       → SetLFCoRem olf rll
tranLFCoRem s I                           = s
tranLFCoRem (s ←∂) (∂c ltr)                = tranLFCoRem (∂→ s) ltr
tranLFCoRem (↓ x) (∂c ltr)                = ↓ x
tranLFCoRem (∂→ s) (∂c ltr)                = tranLFCoRem (s ←∂) ltr
tranLFCoRem (s ←∂→ s₁) (∂c ltr)            = tranLFCoRem (s₁ ←∂→ s) ltr
tranLFCoRem (s ←∨) (∨c ltr)                = tranLFCoRem (∨→ s) ltr
tranLFCoRem (↓ x) (∨c ltr)                = ↓ x
tranLFCoRem (∨→ s) (∨c ltr)                = tranLFCoRem (s ←∨) ltr
tranLFCoRem (s ←∨→ s₁) (∨c ltr)            = tranLFCoRem (s₁ ←∨→ s) ltr
tranLFCoRem (s ←∧) (∧c ltr)                = tranLFCoRem (∧→ s) ltr
tranLFCoRem (↓ x) (∧c ltr)                = ↓ x
tranLFCoRem (∧→ s) (∧c ltr)                = tranLFCoRem (s ←∧) ltr
tranLFCoRem (s ←∧→ s₁) (∧c ltr)            = tranLFCoRem (s₁ ←∧→ s) ltr
tranLFCoRem ((s ←∧) ←∧) (∧∧d ltr)          = tranLFCoRem (s ←∧) ltr
tranLFCoRem (↓ x) (∧∧d ltr)          = ↓ x
tranLFCoRem ((↓ x) ←∧) (∧∧d ltr)          = tranLFCoRem ((↓ x) ←∧→ ((↓ x) ←∧)) ltr
tranLFCoRem ((∧→ s) ←∧) (∧∧d ltr)          = tranLFCoRem (∧→ (s ←∧)) ltr
tranLFCoRem ((s ←∧→ s₁) ←∧) (∧∧d ltr)      = tranLFCoRem (s ←∧→ (s₁ ←∧)) ltr
tranLFCoRem (∧→ s) (∧∧d ltr)               = tranLFCoRem (∧→ (∧→ s)) ltr
tranLFCoRem ((↓ x) ←∧→ s₁) (∧∧d ltr)      = tranLFCoRem ((↓ x) ←∧→ ((↓ x) ←∧→ s₁)) ltr
tranLFCoRem ((s ←∧) ←∧→ s₁) (∧∧d ltr)      = tranLFCoRem (s ←∧→ (∧→ s₁)) ltr
tranLFCoRem ((∧→ s) ←∧→ s₁) (∧∧d ltr)      = tranLFCoRem (∧→ (s ←∧→ s₁)) ltr
tranLFCoRem ((s ←∧→ s₁) ←∧→ s₂) (∧∧d ltr)  = tranLFCoRem (s ←∧→ (s₁ ←∧→ s₂)) ltr
tranLFCoRem (s ←∧) (¬∧∧d ltr)              = tranLFCoRem ((s ←∧) ←∧) ltr
tranLFCoRem (↓ x) (¬∧∧d ltr)              = ↓ x
tranLFCoRem (∧→ (↓ x)) (¬∧∧d ltr)         = tranLFCoRem ((∧→ (↓ x)) ←∧→ (↓ x)) ltr
tranLFCoRem (∧→ (s ←∧)) (¬∧∧d ltr)         = tranLFCoRem ((∧→ s) ←∧) ltr
tranLFCoRem (∧→ (∧→ s)) (¬∧∧d ltr)         = tranLFCoRem (∧→ s) ltr
tranLFCoRem (∧→ (s ←∧→ s₁)) (¬∧∧d ltr)     = tranLFCoRem ((∧→ s) ←∧→ s₁) ltr
tranLFCoRem (s ←∧→ (↓ x)) (¬∧∧d ltr)     = tranLFCoRem ((s ←∧→ (↓ x)) ←∧→ (↓ x)) ltr
tranLFCoRem (s ←∧→ (s₁ ←∧)) (¬∧∧d ltr)     = tranLFCoRem ((s ←∧→ s₁) ←∧) ltr
tranLFCoRem (s ←∧→ (∧→ s₁)) (¬∧∧d ltr)     = tranLFCoRem ((s ←∧) ←∧→ s₁) ltr
tranLFCoRem (s ←∧→ (s₁ ←∧→ s₂)) (¬∧∧d ltr) = tranLFCoRem ((s ←∧→ s₁) ←∧→ s₂) ltr
tranLFCoRem ((s ←∨) ←∨) (∨∨d ltr)          = tranLFCoRem (s ←∨) ltr
tranLFCoRem (↓ x) (∨∨d ltr)          = ↓ x
tranLFCoRem ((↓ x) ←∨) (∨∨d ltr)          = tranLFCoRem ((↓ x) ←∨→ ((↓ x) ←∨)) ltr
tranLFCoRem ((∨→ s) ←∨) (∨∨d ltr)          = tranLFCoRem (∨→ (s ←∨)) ltr
tranLFCoRem ((s ←∨→ s₁) ←∨) (∨∨d ltr)      = tranLFCoRem (s ←∨→ (s₁ ←∨)) ltr
tranLFCoRem (∨→ s) (∨∨d ltr)               = tranLFCoRem (∨→ (∨→ s)) ltr
tranLFCoRem ((↓ x) ←∨→ s₁) (∨∨d ltr)      = tranLFCoRem ((↓ x) ←∨→ ((↓ x) ←∨→ s₁)) ltr
tranLFCoRem ((s ←∨) ←∨→ s₁) (∨∨d ltr)      = tranLFCoRem (s ←∨→ (∨→ s₁)) ltr
tranLFCoRem ((∨→ s) ←∨→ s₁) (∨∨d ltr)      = tranLFCoRem (∨→ (s ←∨→ s₁)) ltr
tranLFCoRem ((s ←∨→ s₁) ←∨→ s₂) (∨∨d ltr)  = tranLFCoRem (s ←∨→ (s₁ ←∨→ s₂)) ltr
tranLFCoRem (s ←∨) (¬∨∨d ltr)              = tranLFCoRem ((s ←∨) ←∨) ltr
tranLFCoRem (↓ x) (¬∨∨d ltr)              = ↓ x
tranLFCoRem (∨→ (↓ x)) (¬∨∨d ltr)         = tranLFCoRem ((∨→ (↓ x)) ←∨→ (↓ x)) ltr
tranLFCoRem (∨→ (s ←∨)) (¬∨∨d ltr)         = tranLFCoRem ((∨→ s) ←∨) ltr
tranLFCoRem (∨→ (∨→ s)) (¬∨∨d ltr)         = tranLFCoRem (∨→ s) ltr
tranLFCoRem (∨→ (s ←∨→ s₁)) (¬∨∨d ltr)     = tranLFCoRem ((∨→ s) ←∨→ s₁) ltr
tranLFCoRem (s ←∨→ (↓ x)) (¬∨∨d ltr)     = tranLFCoRem ((s ←∨→ (↓ x)) ←∨→ (↓ x)) ltr
tranLFCoRem (s ←∨→ (s₁ ←∨)) (¬∨∨d ltr)     = tranLFCoRem ((s ←∨→ s₁) ←∨) ltr
tranLFCoRem (s ←∨→ (∨→ s₁)) (¬∨∨d ltr)     = tranLFCoRem ((s ←∨) ←∨→ s₁) ltr
tranLFCoRem (s ←∨→ (s₁ ←∨→ s₂)) (¬∨∨d ltr) = tranLFCoRem ((s ←∨→ s₁) ←∨→ s₂) ltr
tranLFCoRem ((s ←∂) ←∂) (∂∂d ltr)          = tranLFCoRem (s ←∂) ltr
tranLFCoRem (↓ x) (∂∂d ltr)          = ↓ x
tranLFCoRem ((↓ x) ←∂) (∂∂d ltr)          = tranLFCoRem ((↓ x) ←∂→ ((↓ x) ←∂)) ltr
tranLFCoRem ((∂→ s) ←∂) (∂∂d ltr)          = tranLFCoRem (∂→ (s ←∂)) ltr
tranLFCoRem ((s ←∂→ s₁) ←∂) (∂∂d ltr)      = tranLFCoRem (s ←∂→ (s₁ ←∂)) ltr
tranLFCoRem (∂→ s) (∂∂d ltr)               = tranLFCoRem (∂→ (∂→ s)) ltr
tranLFCoRem ((↓ x) ←∂→ s₁) (∂∂d ltr)      = tranLFCoRem ((↓ x) ←∂→ ((↓ x) ←∂→ s₁)) ltr
tranLFCoRem ((s ←∂) ←∂→ s₁) (∂∂d ltr)      = tranLFCoRem (s ←∂→ (∂→ s₁)) ltr
tranLFCoRem ((∂→ s) ←∂→ s₁) (∂∂d ltr)      = tranLFCoRem (∂→ (s ←∂→ s₁)) ltr
tranLFCoRem ((s ←∂→ s₁) ←∂→ s₂) (∂∂d ltr)  = tranLFCoRem (s ←∂→ (s₁ ←∂→ s₂)) ltr
tranLFCoRem (s ←∂) (¬∂∂d ltr)              = tranLFCoRem ((s ←∂) ←∂) ltr
tranLFCoRem (∂→ (s ←∂)) (¬∂∂d ltr)         = tranLFCoRem ((∂→ s) ←∂) ltr
tranLFCoRem (↓ x) (¬∂∂d ltr)         = ↓ x
tranLFCoRem (∂→ (↓ x)) (¬∂∂d ltr)         = tranLFCoRem ((∂→ (↓ x)) ←∂→ (↓ x)) ltr
tranLFCoRem (∂→ (∂→ s)) (¬∂∂d ltr)         = tranLFCoRem (∂→ s) ltr
tranLFCoRem (∂→ (s ←∂→ s₁)) (¬∂∂d ltr)     = tranLFCoRem ((∂→ s) ←∂→ s₁) ltr
tranLFCoRem (s ←∂→ (↓ x)) (¬∂∂d ltr)     = tranLFCoRem ((s ←∂→ (↓ x)) ←∂→ (↓ x)) ltr
tranLFCoRem (s ←∂→ (s₁ ←∂)) (¬∂∂d ltr)     = tranLFCoRem ((s ←∂→ s₁) ←∂) ltr
tranLFCoRem (s ←∂→ (∂→ s₁)) (¬∂∂d ltr)     = tranLFCoRem ((s ←∂) ←∂→ s₁) ltr
tranLFCoRem (s ←∂→ (s₁ ←∂→ s₂)) (¬∂∂d ltr) = tranLFCoRem ((s ←∂→ s₁) ←∂→ s₂) ltr

extendLFCoRem : ∀{i u oll orll ll pll} → {olf : LFun {i} {u} oll orll} → IndexLL {i} {u} pll ll → SetLFCoRem {i} olf pll → SetLFCoRem olf ll
extendLFCoRem ↓ sr = sr
extendLFCoRem (ind ←∧) sr = (extendLFCoRem ind sr) ←∧
extendLFCoRem (∧→ ind) sr = ∧→ (extendLFCoRem ind sr)
extendLFCoRem (ind ←∨) sr = (extendLFCoRem ind sr) ←∨
extendLFCoRem (∨→ ind) sr = ∨→ (extendLFCoRem ind sr)
extendLFCoRem (ind ←∂) sr = (extendLFCoRem ind sr) ←∂
extendLFCoRem (∂→ ind) sr = ∂→ (extendLFCoRem ind sr)

replaceLFCoRem : ∀{i u oll orll ll pll rll} → {olf : LFun {i} {u} oll orll} → (ind : IndexLL {i} {u} pll ll) → SetLFCoRem {i} olf rll → SetLFCoRem olf ll → SetLFCoRem olf (replLL ll ind rll)
replaceLFCoRem ↓ esr sr = esr
replaceLFCoRem {rll = rll} (ind ←∧) esr (↓ x) = (extendLFCoRem (updInd rll ind) esr) ←∧
replaceLFCoRem {rll = rll} (ind ←∧) esr (sr ←∧) = replaceLFCoRem ind esr sr ←∧
replaceLFCoRem {rll = rll} (ind ←∧) esr (∧→ sr) = (extendLFCoRem (updInd rll ind) esr) ←∧→ sr
replaceLFCoRem {rll = rll} (ind ←∧) esr (sr ←∧→ sr₁) = (replaceLFCoRem ind esr sr) ←∧→ sr₁
replaceLFCoRem {rll = rll} (∧→ ind) esr (↓ x) = ∧→ (extendLFCoRem (updInd rll ind) esr)
replaceLFCoRem {rll = rll} (∧→ ind) esr (sr ←∧) = sr ←∧→ (extendLFCoRem (updInd rll ind) esr)
replaceLFCoRem {rll = rll} (∧→ ind) esr (∧→ sr) = ∧→ replaceLFCoRem ind esr sr
replaceLFCoRem {rll = rll} (∧→ ind) esr (sr ←∧→ sr₁) = sr ←∧→ replaceLFCoRem ind esr sr₁
replaceLFCoRem {rll = rll} (ind ←∨) esr (↓ x) = (extendLFCoRem (updInd rll ind) esr) ←∨
replaceLFCoRem {rll = rll} (ind ←∨) esr (sr ←∨) = replaceLFCoRem ind esr sr ←∨
replaceLFCoRem {rll = rll} (ind ←∨) esr (∨→ sr) = (extendLFCoRem (updInd rll ind) esr) ←∨→ sr
replaceLFCoRem {rll = rll} (ind ←∨) esr (sr ←∨→ sr₁) = (replaceLFCoRem ind esr sr) ←∨→ sr₁
replaceLFCoRem {rll = rll} (∨→ ind) esr (↓ x) = ∨→ (extendLFCoRem (updInd rll ind) esr)
replaceLFCoRem {rll = rll} (∨→ ind) esr (sr ←∨) = sr ←∨→ (extendLFCoRem (updInd rll ind) esr)
replaceLFCoRem {rll = rll} (∨→ ind) esr (∨→ sr) = ∨→ replaceLFCoRem ind esr sr
replaceLFCoRem {rll = rll} (∨→ ind) esr (sr ←∨→ sr₁) = sr ←∨→ replaceLFCoRem ind esr sr₁
replaceLFCoRem {rll = rll} (ind ←∂) esr (↓ x) = (extendLFCoRem (updInd rll ind) esr) ←∂
replaceLFCoRem {rll = rll} (ind ←∂) esr (sr ←∂) = replaceLFCoRem ind esr sr ←∂
replaceLFCoRem {rll = rll} (ind ←∂) esr (∂→ sr) = (extendLFCoRem (updInd rll ind) esr) ←∂→ sr
replaceLFCoRem {rll = rll} (ind ←∂) esr (sr ←∂→ sr₁) = (replaceLFCoRem ind esr sr) ←∂→ sr₁
replaceLFCoRem {rll = rll} (∂→ ind) esr (↓ x) = ∂→ (extendLFCoRem (updInd rll ind) esr)
replaceLFCoRem {rll = rll} (∂→ ind) esr (sr ←∂) = sr ←∂→ (extendLFCoRem (updInd rll ind) esr)
replaceLFCoRem {rll = rll} (∂→ ind) esr (∂→ sr) = ∂→ replaceLFCoRem ind esr sr
replaceLFCoRem {rll = rll} (∂→ ind) esr (sr ←∂→ sr₁) = sr ←∂→ replaceLFCoRem ind esr sr₁

mreplaceLFCoRem :  ∀{i u oll orll ll pll rll} → {olf : LFun {i} {u} oll orll} → (ind : IndexLL {i} {u} pll ll) → MSetLFCoRem {i} olf rll → MSetLFCoRem olf ll → MSetLFCoRem olf (replLL ll ind rll)
mreplaceLFCoRem ind ∅ ∅ = ∅
mreplaceLFCoRem {rll = rll} ind ∅ (¬∅ x) = delLFCoRem x ind rll
mreplaceLFCoRem {rll = rll} ind (¬∅ x) ∅ = ¬∅ (extendLFCoRem (updInd rll ind) x)
mreplaceLFCoRem ind (¬∅ x) (¬∅ x₁) = ¬∅ (replaceLFCoRem ind x x₁)

{-# OPTIONS --exact-split #-}
module IndexLFCo where

open import Common
open import LinLogic
open import LinLogicProp
open import LinFun
open import IndexLLProp
open import Data.Maybe

module _ where

  import Relation.Binary.PropositionalEquality
  open  Relation.Binary.PropositionalEquality.Deprecated-inspect

  -- reverseTran returns nothing if during the reversion, it finds a com.
  -- or if the cll is transformed.

  reverseTran : ∀{i u ll cll rll} → LFun ll rll → IndexLL {i} {u} cll rll → Maybe $ IndexLL cll ll
  reverseTran I i = just i
  reverseTran (_⊂_ {ell = ell} {ind = ind} lf lf₁) i with (reverseTran lf₁ i)
  reverseTran (_⊂_ {_} {_} {ell} {_} {ind} lf lf₁) i | just x with (inspect (x -ₘᵢ (updInd ell ind)))
  reverseTran (_⊂_ {_} {_} {ell} {_} {ind} lf lf₁) i | just x | ((just x₁) with-≡ eq₁) with (reverseTran lf x₁)
  reverseTran (_⊂_ {pll} {ll} {ell} {_} {ind} lf lf₁) i | just x | ((just x₁) with-≡ eq₁) | (just x₂) = just $ ind +ᵢ x₂
  reverseTran (_⊂_ {_} {_} {ell} {_} {ind} lf lf₁) i | just x | ((just x₁) with-≡ eq₁) | nothing = nothing
  reverseTran (_⊂_ {_} {_} {ell} {_} {ind} lf lf₁) i | just x | (nothing with-≡ eq₁) with (inspect ((updInd ell ind) -ₘᵢ x))
  reverseTran (_⊂_ {_} {_} {ell} {_} {ind} lf lf₁) i₁ | just x | (nothing with-≡ eq₁) | ((just x₁) with-≡ eq₂) = nothing -- We do not accept transformations that change the cll. The cll definitely changes here. (unless lf only has I).
  reverseTran (_⊂_ {_} {_} {ell} {_} {ind} lf lf₁) i₁ | just x | (nothing with-≡ eq₁) | (nothing with-≡ eq₂) = just $ revUpdInd ind x eq₁ eq₂
  reverseTran (_⊂_ {_} {_} {ell} {_} {ind} lf lf₁) i | nothing = nothing
  reverseTran (tr ltr lf) i with (reverseTran lf i)
  reverseTran (tr ltr lf) i₁ | just x = tran x $ revTr ltr
  reverseTran (tr ltr lf) i₁ | nothing = nothing
  reverseTran (com df lf) i = nothing
  reverseTran (call x) i = nothing

  data ReverseTranT {i u} : ∀{ll cll rll} → LFun ll rll → IndexLL {i} {u} cll rll → Set u where
    cr1 : ∀{cll rll} → {iind : IndexLL {i} {u} cll rll} → ReverseTranT I iind
    cr2 : ∀{ll cll rll ell pll ind lf₁ lf x x₁ x₂} → {iind : IndexLL {i} {u} cll rll} → (just x ≡ reverseTran lf₁ iind) → (just x₁ ≡ x -ₘᵢ (updInd ell ind)) → (just x₂ ≡ reverseTran lf x₁) → ReverseTranT (_⊂_ {pll = pll} {ll = ll} {ell = ell} {rll = rll} {ind = ind} lf lf₁) iind
    cr3 : ∀{ll cll rll ell pll ind lf₁ lf x } → {iind : IndexLL {i} {u} cll rll} → (just x ≡ reverseTran lf₁ iind) → (eq₁ : (nothing ≡ x -ₘᵢ (updInd ell ind))) → (eq₂ :((updInd ell ind) -ₘᵢ x ≡ nothing)) → ReverseTranT (_⊂_ {pll = pll} {ll = ll} {ell = ell} {rll = rll} {ind = ind} lf lf₁) iind
    cr4 : ∀{ll cll orll rll lf x} → {ltr : LLTr orll ll} → {iind : IndexLL {i} {u} cll rll} → (just x ≡ reverseTran lf iind) → ReverseTranT (tr ltr lf) iind

  -- This is almost the same code as above but it is required in IndexLFCo.
  indRevNoComs : ∀{i u ll pll ell cll} → (ind : IndexLL {i} {u} pll ll) → IndexLL cll (replLL ll ind ell) → LFun pll ell → Maybe $ IndexLL cll ll
  indRevNoComs {ell = ell} ind lind lf with (inspect (lind -ₘᵢ (updInd ell ind)))
  indRevNoComs {_} {_} {_} {_} {ell} ind lind lf | just x with-≡ eq with (reverseTran lf x)
  indRevNoComs {_} {_} {_} {_} {ell} ind lind lf | just x with-≡ eq | (just x₁) = just $ ind +ᵢ x₁
  indRevNoComs {_} {_} {_} {_} {ell} ind lind lf | just x with-≡ eq | nothing = nothing
  indRevNoComs {_} {_} {_} {_} {ell} ind lind lf | nothing with-≡ eq with (inspect ((updInd ell ind) -ₘᵢ lind))
  indRevNoComs {_} {_} {_} {_} {ell} ind lind lf | nothing with-≡ eq | (just x with-≡ eq₁) = nothing
  indRevNoComs {_} {_} {_} {_} {ell} ind lind lf | nothing with-≡ eq | (nothing with-≡ eq₁) = just $ revUpdInd ind lind eq eq₁

  data IndRevNoComsT {i u ll pll ell cll} {ind : IndexLL {i} {u} pll ll} {lind : IndexLL cll (replLL ll ind ell)} {lf : LFun pll ell} : Set u where
    c1 : ∀{x x₁} → (just x ≡ lind -ₘᵢ (updInd ell ind)) → (x₁ ≡ reverseTran lf x) → IndRevNoComsT
    c2 : (nothing ≡ lind -ₘᵢ (updInd ell ind)) → (nothing ≡ (updInd ell ind) -ₘᵢ lind) → IndRevNoComsT

data IndexLFCo {i u cll} (frll : LinLogic i {u}) : ∀{ll rll} → IndexLL cll ll → LFun {i} {u} ll rll → Set (u) where
  _←⊂ : ∀{rll pll ell ll ind elf lf lind}
         → IndexLFCo frll lind elf
         → IndexLFCo frll (ind +ᵢ lind) (_⊂_ {i} {u} {pll} {ll} {ell} {rll} {ind} elf lf)
  ⊂→_ : ∀{rll pll ell ll ind elf lf lind rs}
         → IndexLFCo frll lind lf
         → {prf : just rs ≡ indRevNoComs ind lind elf}
         → IndexLFCo frll rs (_⊂_ {i} {u} {pll} {ll} {ell} {rll} {ind} elf lf)
  tr   : ∀{ll orll rll lind rs} → {ltr : LLTr orll ll} → {lf : LFun {i} {u} orll rll}
         → IndexLFCo frll lind lf
         → {prf : just rs ≡ tran lind (revTr ltr) }
         → IndexLFCo frll rs (tr ltr lf)
  ↓  : ∀{rll prfi prfo df lf}
         → IndexLFCo  frll ↓ (com {i} {u} {rll} {cll} {frll} {{prfi}} {{prfo}} df lf)

data SetLFCoRem {i u oll orll} (olf : LFun {i} {u} oll orll) : LinLogic i {u} → Set (lsuc u) where
  ↓    : ∀{ll cll frll} → {ind : IndexLL {i} {u} cll oll} → IndexLFCo frll ind olf → SetLFCoRem olf ll
  _←∧   : ∀{rs ls} → SetLFCoRem olf ls                   → SetLFCoRem olf (ls ∧ rs)
  ∧→_   : ∀{rs ls} → SetLFCoRem olf rs                   → SetLFCoRem olf (ls ∧ rs)
  _←∧→_ : ∀{rs ls} → SetLFCoRem olf ls → SetLFCoRem olf rs → SetLFCoRem olf (ls ∧ rs)
  _←∨   : ∀{rs ls} → SetLFCoRem olf ls                   → SetLFCoRem olf (ls ∨ rs)
  ∨→_   : ∀{rs ls} → SetLFCoRem olf rs                   → SetLFCoRem olf (ls ∨ rs)
  _←∨→_ : ∀{rs ls} → SetLFCoRem olf ls → SetLFCoRem olf rs → SetLFCoRem olf (ls ∨ rs)
  _←∂   : ∀{rs ls} → SetLFCoRem olf ls                   → SetLFCoRem olf (ls ∂ rs)
  ∂→_   : ∀{rs ls} → SetLFCoRem olf rs                   → SetLFCoRem olf (ls ∂ rs)
  _←∂→_ : ∀{rs ls} → SetLFCoRem olf ls → SetLFCoRem olf rs → SetLFCoRem olf (ls ∂ rs)

data MSetLFCoRem {i u oll orll} (olf : LFun {i} {u} oll orll) : LinLogic i {u} → Set (lsuc u) where
  ∅   : ∀{ll}            → MSetLFCoRem olf ll
  ¬∅  : ∀{ll} → SetLFCoRem olf ll → MSetLFCoRem olf ll

∅-addLFCoRem : ∀{i u ll pll oll orll frll cll} → {iind : IndexLL cll oll} → {olf : LFun {i} {u} oll orll} → (ind : IndexLL {i} {u} pll ll) → IndexLFCo frll iind olf
        → SetLFCoRem olf ll
∅-addLFCoRem ↓ m = ↓ m
∅-addLFCoRem (ind ←∧) m = (∅-addLFCoRem ind m) ←∧
∅-addLFCoRem (∧→ ind) m = ∧→ (∅-addLFCoRem ind m)
∅-addLFCoRem (ind ←∨) m = (∅-addLFCoRem ind m) ←∨
∅-addLFCoRem (∨→ ind) m = ∨→ (∅-addLFCoRem ind m)
∅-addLFCoRem (ind ←∂) m = (∅-addLFCoRem ind m) ←∂
∅-addLFCoRem (∂→ ind) m = ∂→ (∅-addLFCoRem ind m)

addLFCoRem : ∀{i u ll pll oll orll frll cll} → {iind : IndexLL cll oll} → {olf : LFun {i} {u} oll orll} → SetLFCoRem olf ll → (ind : IndexLL {i} {u} pll ll) → IndexLFCo frll iind olf
        → SetLFCoRem olf ll
addLFCoRem (↓ rm) ind m          = ↓ m
addLFCoRem (x ←∧) ↓ m            = ↓ m
addLFCoRem (∧→ x) ↓ m            = ↓ m --TODO Here we lose the information that is at lower levels.
addLFCoRem (x ←∧→ x₁) ↓ m        = ↓ m
addLFCoRem (x ←∨) ↓ m            = ↓ m
addLFCoRem (∨→ x) ↓ m            = ↓ m
addLFCoRem (x ←∨→ x₁) ↓ m        = ↓ m
addLFCoRem (x ←∂) ↓ m            = ↓ m
addLFCoRem (∂→ x) ↓ m            = ↓ m
addLFCoRem (x ←∂→ x₁) ↓ m        = ↓ m
addLFCoRem (s ←∧) (ind ←∧) m     = (addLFCoRem s ind m) ←∧
addLFCoRem (s ←∧) (∧→ ind) m     = s ←∧→ (∅-addLFCoRem ind m)
addLFCoRem (∧→ s) (ind ←∧) m     = (∅-addLFCoRem ind m) ←∧→ s
addLFCoRem (∧→ s) (∧→ ind) m     = ∧→ addLFCoRem s ind m
addLFCoRem (s ←∧→ s₁) (ind ←∧) m = (addLFCoRem s ind m) ←∧→ s₁
addLFCoRem (s ←∧→ s₁) (∧→ ind) m = s ←∧→ (addLFCoRem s₁ ind m)
addLFCoRem (s ←∨) (ind ←∨) m     = (addLFCoRem s ind m) ←∨
addLFCoRem (s ←∨) (∨→ ind) m     = s ←∨→ (∅-addLFCoRem ind m)
addLFCoRem (∨→ s) (ind ←∨) m     = (∅-addLFCoRem ind m) ←∨→ s
addLFCoRem (∨→ s) (∨→ ind) m     = ∨→ addLFCoRem s ind m
addLFCoRem (s ←∨→ s₁) (ind ←∨) m = (addLFCoRem s ind m) ←∨→ s₁
addLFCoRem (s ←∨→ s₁) (∨→ ind) m = s ←∨→ (addLFCoRem s₁ ind m)
addLFCoRem (s ←∂) (ind ←∂) m     = (addLFCoRem s ind m) ←∂
addLFCoRem (s ←∂) (∂→ ind) m     = s ←∂→ (∅-addLFCoRem ind m)
addLFCoRem (∂→ s) (ind ←∂) m     = (∅-addLFCoRem ind m) ←∂→ s
addLFCoRem (∂→ s) (∂→ ind) m     = ∂→ addLFCoRem s ind m
addLFCoRem (s ←∂→ s₁) (ind ←∂) m = (addLFCoRem s ind m) ←∂→ s₁
addLFCoRem (s ←∂→ s₁) (∂→ ind) m = s ←∂→ (addLFCoRem s₁ ind m)

maddLFCoRem : ∀{i u ll pll oll orll frll cll} → {iind : IndexLL cll oll} → {olf : LFun {i} {u} oll orll} → MSetLFCoRem olf ll → (ind : IndexLL {i} {u} pll ll) → IndexLFCo frll iind olf
      → MSetLFCoRem olf ll
maddLFCoRem ∅ ind m = ¬∅ (∅-addLFCoRem ind m)
maddLFCoRem (¬∅ x) ind m = ¬∅ (addLFCoRem x ind m)

truncSetLFCoRem : ∀{i} → ∀{u ll oll orll q} → {olf : LFun {i} {u} oll orll} → MSetLFCoRem {i} {u} olf ll → (ind : IndexLL {i} {u} q ll) → MSetLFCoRem {i} olf q
truncSetLFCoRem ∅ ind = ∅
truncSetLFCoRem (¬∅ x) ↓ = ¬∅ x
truncSetLFCoRem (¬∅ (↓ x)) (ind ←∧) = ∅
truncSetLFCoRem (¬∅ (x ←∧)) (ind ←∧) = truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (∧→ x)) (ind ←∧) = ∅
truncSetLFCoRem (¬∅ (x ←∧→ x₁)) (ind ←∧) = truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (↓ x)) (∧→ ind) = ∅
truncSetLFCoRem (¬∅ (x ←∧)) (∧→ ind) = ∅
truncSetLFCoRem (¬∅ (∧→ x)) (∧→ ind) =  truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (x ←∧→ x₁)) (∧→ ind) =  truncSetLFCoRem (¬∅ x₁) ind
truncSetLFCoRem (¬∅ (↓ x)) (ind ←∨) = ∅
truncSetLFCoRem (¬∅ (x ←∨)) (ind ←∨) = truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (∨→ x)) (ind ←∨) = ∅
truncSetLFCoRem (¬∅ (x ←∨→ x₁)) (ind ←∨) = truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (↓ x)) (∨→ ind) = ∅
truncSetLFCoRem (¬∅ (x ←∨)) (∨→ ind) = ∅
truncSetLFCoRem (¬∅ (∨→ x)) (∨→ ind) =  truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (x ←∨→ x₁)) (∨→ ind) =  truncSetLFCoRem (¬∅ x₁) ind
truncSetLFCoRem (¬∅ (↓ x)) (ind ←∂) = ∅
truncSetLFCoRem (¬∅ (x ←∂)) (ind ←∂) = truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (∂→ x)) (ind ←∂) = ∅
truncSetLFCoRem (¬∅ (x ←∂→ x₁)) (ind ←∂) = truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (↓ x)) (∂→ ind) = ∅
truncSetLFCoRem (¬∅ (x ←∂)) (∂→ ind) = ∅
truncSetLFCoRem (¬∅ (∂→ x)) (∂→ ind) =  truncSetLFCoRem (¬∅ x) ind
truncSetLFCoRem (¬∅ (x ←∂→ x₁)) (∂→ ind) =  truncSetLFCoRem (¬∅ x₁) ind

delLFCoRem : ∀{i u oll orll ll pll} → {olf : LFun {i} {u} oll orll} → SetLFCoRem {i} olf ll → (ind : IndexLL {i} {u} pll ll) → (rll : LinLogic i)
      → MSetLFCoRem {i} olf (replLL ll ind rll)
delLFCoRem s ↓ rll = ∅
delLFCoRem (↓ x) (ind ←∧) rll = ∅ -- We loose Information.
delLFCoRem (s ←∧) (ind ←∧) rll with (delLFCoRem s ind rll)
delLFCoRem (s ←∧) (ind ←∧) rll | ∅ = ∅
delLFCoRem (s ←∧) (ind ←∧) rll | ¬∅ x = ¬∅ (x ←∧)
delLFCoRem (∧→ s) (ind ←∧) rll = ¬∅ (∧→ (s))
delLFCoRem (s ←∧→ s₁) (ind ←∧) rll with (delLFCoRem s ind rll)
delLFCoRem (s ←∧→ s₁) (ind ←∧) rll | ∅ = ¬∅ (∧→ (s₁))
delLFCoRem (s ←∧→ s₁) (ind ←∧) rll | ¬∅ x = ¬∅ (x ←∧→ (s₁))
delLFCoRem (↓ x) (∧→ ind) rll = ∅ --
delLFCoRem (s ←∧) (∧→ ind) rll = ¬∅ ((s) ←∧)
delLFCoRem (∧→ s) (∧→ ind) rll with (delLFCoRem s ind rll)
delLFCoRem (∧→ s) (∧→ ind) rll | ∅ = ∅
delLFCoRem (∧→ s) (∧→ ind) rll | ¬∅ x = ¬∅ (∧→ x)
delLFCoRem (s ←∧→ s₁) (∧→ ind) rll with (delLFCoRem s₁ ind rll)
delLFCoRem (s ←∧→ s₁) (∧→ ind) rll | ∅ = ¬∅ ((s) ←∧)
delLFCoRem (s ←∧→ s₁) (∧→ ind) rll | ¬∅ x = ¬∅ ((s) ←∧→ x)
delLFCoRem (↓ x) (ind ←∨) rll = ∅
delLFCoRem (s ←∨) (ind ←∨) rll with (delLFCoRem s ind rll)
delLFCoRem (s ←∨) (ind ←∨) rll | ∅ = ∅
delLFCoRem (s ←∨) (ind ←∨) rll | ¬∅ x = ¬∅ (x ←∨)
delLFCoRem (∨→ s) (ind ←∨) rll = ¬∅ (∨→ (s))
delLFCoRem (s ←∨→ s₁) (ind ←∨) rll with (delLFCoRem s ind rll)
delLFCoRem (s ←∨→ s₁) (ind ←∨) rll | ∅ = ¬∅ (∨→ (s₁))
delLFCoRem (s ←∨→ s₁) (ind ←∨) rll | ¬∅ x = ¬∅ (x ←∨→ (s₁))
delLFCoRem (↓ x) (∨→ ind) rll = ∅
delLFCoRem (s ←∨) (∨→ ind) rll = ¬∅ ((s) ←∨)
delLFCoRem (∨→ s) (∨→ ind) rll with (delLFCoRem s ind rll)
delLFCoRem (∨→ s) (∨→ ind) rll | ∅ = ∅
delLFCoRem (∨→ s) (∨→ ind) rll | ¬∅ x = ¬∅ (∨→ x)
delLFCoRem (s ←∨→ s₁) (∨→ ind) rll with (delLFCoRem s₁ ind rll)
delLFCoRem (s ←∨→ s₁) (∨→ ind) rll | ∅ = ¬∅ ((s) ←∨)
delLFCoRem (s ←∨→ s₁) (∨→ ind) rll | ¬∅ x = ¬∅ ((s) ←∨→ x)
delLFCoRem (↓ x) (ind ←∂) rll = ∅
delLFCoRem (s ←∂) (ind ←∂) rll with (delLFCoRem s ind rll)
delLFCoRem (s ←∂) (ind ←∂) rll | ∅ = ∅
delLFCoRem (s ←∂) (ind ←∂) rll | ¬∅ x = ¬∅ (x ←∂)
delLFCoRem (∂→ s) (ind ←∂) rll = ¬∅ (∂→ (s))
delLFCoRem (s ←∂→ s₁) (ind ←∂) rll with (delLFCoRem s ind rll)
delLFCoRem (s ←∂→ s₁) (ind ←∂) rll | ∅ = ¬∅ (∂→ (s₁))
delLFCoRem (s ←∂→ s₁) (ind ←∂) rll | ¬∅ x = ¬∅ (x ←∂→ (s₁))
delLFCoRem (↓ x) (∂→ ind) rll = ∅
delLFCoRem (s ←∂) (∂→ ind) rll = ¬∅ ((s) ←∂)
delLFCoRem (∂→ s) (∂→ ind) rll with (delLFCoRem s ind rll)
delLFCoRem (∂→ s) (∂→ ind) rll | ∅ = ∅
delLFCoRem (∂→ s) (∂→ ind) rll | ¬∅ x = ¬∅ (∂→ x)
delLFCoRem (s ←∂→ s₁) (∂→ ind) rll with (delLFCoRem s₁ ind rll)
delLFCoRem (s ←∂→ s₁) (∂→ ind) rll | ∅ = ¬∅ ((s) ←∂)
delLFCoRem (s ←∂→ s₁) (∂→ ind) rll | ¬∅ x = ¬∅ ((s) ←∂→ x)

mdelLFCoRem : ∀{i u oll orll ll pll} → {olf : LFun {i} {u} oll orll} → MSetLFCoRem {i} olf ll → (ind : IndexLL {i} {u} pll ll) → (rll : LinLogic i)
             → MSetLFCoRem {i} olf (replLL ll ind rll)
mdelLFCoRem ∅ ind rll = ∅
mdelLFCoRem (¬∅ x) ind rll = delLFCoRem x ind rll

tranLFCoRem : ∀{i u oll orll ll rll} → {olf : LFun {i} {u} oll orll} → SetLFCoRem {i} olf ll → (tr : LLTr {i} {u} rll ll)
       → SetLFCoRem olf rll
tranLFCoRem s I                           = s
tranLFCoRem (s ←∂) (∂c ltr)                = tranLFCoRem (∂→ s) ltr
tranLFCoRem (↓ x) (∂c ltr)                = ↓ x
tranLFCoRem (∂→ s) (∂c ltr)                = tranLFCoRem (s ←∂) ltr
tranLFCoRem (s ←∂→ s₁) (∂c ltr)            = tranLFCoRem (s₁ ←∂→ s) ltr
tranLFCoRem (s ←∨) (∨c ltr)                = tranLFCoRem (∨→ s) ltr
tranLFCoRem (↓ x) (∨c ltr)                = ↓ x
tranLFCoRem (∨→ s) (∨c ltr)                = tranLFCoRem (s ←∨) ltr
tranLFCoRem (s ←∨→ s₁) (∨c ltr)            = tranLFCoRem (s₁ ←∨→ s) ltr
tranLFCoRem (s ←∧) (∧c ltr)                = tranLFCoRem (∧→ s) ltr
tranLFCoRem (↓ x) (∧c ltr)                = ↓ x
tranLFCoRem (∧→ s) (∧c ltr)                = tranLFCoRem (s ←∧) ltr
tranLFCoRem (s ←∧→ s₁) (∧c ltr)            = tranLFCoRem (s₁ ←∧→ s) ltr
tranLFCoRem ((s ←∧) ←∧) (∧∧d ltr)          = tranLFCoRem (s ←∧) ltr
tranLFCoRem (↓ x) (∧∧d ltr)          = ↓ x
tranLFCoRem ((↓ x) ←∧) (∧∧d ltr)          = tranLFCoRem ((↓ x) ←∧→ ((↓ x) ←∧)) ltr
tranLFCoRem ((∧→ s) ←∧) (∧∧d ltr)          = tranLFCoRem (∧→ (s ←∧)) ltr
tranLFCoRem ((s ←∧→ s₁) ←∧) (∧∧d ltr)      = tranLFCoRem (s ←∧→ (s₁ ←∧)) ltr
tranLFCoRem (∧→ s) (∧∧d ltr)               = tranLFCoRem (∧→ (∧→ s)) ltr
tranLFCoRem ((↓ x) ←∧→ s₁) (∧∧d ltr)      = tranLFCoRem ((↓ x) ←∧→ ((↓ x) ←∧→ s₁)) ltr
tranLFCoRem ((s ←∧) ←∧→ s₁) (∧∧d ltr)      = tranLFCoRem (s ←∧→ (∧→ s₁)) ltr
tranLFCoRem ((∧→ s) ←∧→ s₁) (∧∧d ltr)      = tranLFCoRem (∧→ (s ←∧→ s₁)) ltr
tranLFCoRem ((s ←∧→ s₁) ←∧→ s₂) (∧∧d ltr)  = tranLFCoRem (s ←∧→ (s₁ ←∧→ s₂)) ltr
tranLFCoRem (s ←∧) (¬∧∧d ltr)              = tranLFCoRem ((s ←∧) ←∧) ltr
tranLFCoRem (↓ x) (¬∧∧d ltr)              = ↓ x
tranLFCoRem (∧→ (↓ x)) (¬∧∧d ltr)         = tranLFCoRem ((∧→ (↓ x)) ←∧→ (↓ x)) ltr
tranLFCoRem (∧→ (s ←∧)) (¬∧∧d ltr)         = tranLFCoRem ((∧→ s) ←∧) ltr
tranLFCoRem (∧→ (∧→ s)) (¬∧∧d ltr)         = tranLFCoRem (∧→ s) ltr
tranLFCoRem (∧→ (s ←∧→ s₁)) (¬∧∧d ltr)     = tranLFCoRem ((∧→ s) ←∧→ s₁) ltr
tranLFCoRem (s ←∧→ (↓ x)) (¬∧∧d ltr)     = tranLFCoRem ((s ←∧→ (↓ x)) ←∧→ (↓ x)) ltr
tranLFCoRem (s ←∧→ (s₁ ←∧)) (¬∧∧d ltr)     = tranLFCoRem ((s ←∧→ s₁) ←∧) ltr
tranLFCoRem (s ←∧→ (∧→ s₁)) (¬∧∧d ltr)     = tranLFCoRem ((s ←∧) ←∧→ s₁) ltr
tranLFCoRem (s ←∧→ (s₁ ←∧→ s₂)) (¬∧∧d ltr) = tranLFCoRem ((s ←∧→ s₁) ←∧→ s₂) ltr
tranLFCoRem ((s ←∨) ←∨) (∨∨d ltr)          = tranLFCoRem (s ←∨) ltr
tranLFCoRem (↓ x) (∨∨d ltr)          = ↓ x
tranLFCoRem ((↓ x) ←∨) (∨∨d ltr)          = tranLFCoRem ((↓ x) ←∨→ ((↓ x) ←∨)) ltr
tranLFCoRem ((∨→ s) ←∨) (∨∨d ltr)          = tranLFCoRem (∨→ (s ←∨)) ltr
tranLFCoRem ((s ←∨→ s₁) ←∨) (∨∨d ltr)      = tranLFCoRem (s ←∨→ (s₁ ←∨)) ltr
tranLFCoRem (∨→ s) (∨∨d ltr)               = tranLFCoRem (∨→ (∨→ s)) ltr
tranLFCoRem ((↓ x) ←∨→ s₁) (∨∨d ltr)      = tranLFCoRem ((↓ x) ←∨→ ((↓ x) ←∨→ s₁)) ltr
tranLFCoRem ((s ←∨) ←∨→ s₁) (∨∨d ltr)      = tranLFCoRem (s ←∨→ (∨→ s₁)) ltr
tranLFCoRem ((∨→ s) ←∨→ s₁) (∨∨d ltr)      = tranLFCoRem (∨→ (s ←∨→ s₁)) ltr
tranLFCoRem ((s ←∨→ s₁) ←∨→ s₂) (∨∨d ltr)  = tranLFCoRem (s ←∨→ (s₁ ←∨→ s₂)) ltr
tranLFCoRem (s ←∨) (¬∨∨d ltr)              = tranLFCoRem ((s ←∨) ←∨) ltr
tranLFCoRem (↓ x) (¬∨∨d ltr)              = ↓ x
tranLFCoRem (∨→ (↓ x)) (¬∨∨d ltr)         = tranLFCoRem ((∨→ (↓ x)) ←∨→ (↓ x)) ltr
tranLFCoRem (∨→ (s ←∨)) (¬∨∨d ltr)         = tranLFCoRem ((∨→ s) ←∨) ltr
tranLFCoRem (∨→ (∨→ s)) (¬∨∨d ltr)         = tranLFCoRem (∨→ s) ltr
tranLFCoRem (∨→ (s ←∨→ s₁)) (¬∨∨d ltr)     = tranLFCoRem ((∨→ s) ←∨→ s₁) ltr
tranLFCoRem (s ←∨→ (↓ x)) (¬∨∨d ltr)     = tranLFCoRem ((s ←∨→ (↓ x)) ←∨→ (↓ x)) ltr
tranLFCoRem (s ←∨→ (s₁ ←∨)) (¬∨∨d ltr)     = tranLFCoRem ((s ←∨→ s₁) ←∨) ltr
tranLFCoRem (s ←∨→ (∨→ s₁)) (¬∨∨d ltr)     = tranLFCoRem ((s ←∨) ←∨→ s₁) ltr
tranLFCoRem (s ←∨→ (s₁ ←∨→ s₂)) (¬∨∨d ltr) = tranLFCoRem ((s ←∨→ s₁) ←∨→ s₂) ltr
tranLFCoRem ((s ←∂) ←∂) (∂∂d ltr)          = tranLFCoRem (s ←∂) ltr
tranLFCoRem (↓ x) (∂∂d ltr)          = ↓ x
tranLFCoRem ((↓ x) ←∂) (∂∂d ltr)          = tranLFCoRem ((↓ x) ←∂→ ((↓ x) ←∂)) ltr
tranLFCoRem ((∂→ s) ←∂) (∂∂d ltr)          = tranLFCoRem (∂→ (s ←∂)) ltr
tranLFCoRem ((s ←∂→ s₁) ←∂) (∂∂d ltr)      = tranLFCoRem (s ←∂→ (s₁ ←∂)) ltr
tranLFCoRem (∂→ s) (∂∂d ltr)               = tranLFCoRem (∂→ (∂→ s)) ltr
tranLFCoRem ((↓ x) ←∂→ s₁) (∂∂d ltr)      = tranLFCoRem ((↓ x) ←∂→ ((↓ x) ←∂→ s₁)) ltr
tranLFCoRem ((s ←∂) ←∂→ s₁) (∂∂d ltr)      = tranLFCoRem (s ←∂→ (∂→ s₁)) ltr
tranLFCoRem ((∂→ s) ←∂→ s₁) (∂∂d ltr)      = tranLFCoRem (∂→ (s ←∂→ s₁)) ltr
tranLFCoRem ((s ←∂→ s₁) ←∂→ s₂) (∂∂d ltr)  = tranLFCoRem (s ←∂→ (s₁ ←∂→ s₂)) ltr
tranLFCoRem (s ←∂) (¬∂∂d ltr)              = tranLFCoRem ((s ←∂) ←∂) ltr
tranLFCoRem (∂→ (s ←∂)) (¬∂∂d ltr)         = tranLFCoRem ((∂→ s) ←∂) ltr
tranLFCoRem (↓ x) (¬∂∂d ltr)         = ↓ x
tranLFCoRem (∂→ (↓ x)) (¬∂∂d ltr)         = tranLFCoRem ((∂→ (↓ x)) ←∂→ (↓ x)) ltr
tranLFCoRem (∂→ (∂→ s)) (¬∂∂d ltr)         = tranLFCoRem (∂→ s) ltr
tranLFCoRem (∂→ (s ←∂→ s₁)) (¬∂∂d ltr)     = tranLFCoRem ((∂→ s) ←∂→ s₁) ltr
tranLFCoRem (s ←∂→ (↓ x)) (¬∂∂d ltr)     = tranLFCoRem ((s ←∂→ (↓ x)) ←∂→ (↓ x)) ltr
tranLFCoRem (s ←∂→ (s₁ ←∂)) (¬∂∂d ltr)     = tranLFCoRem ((s ←∂→ s₁) ←∂) ltr
tranLFCoRem (s ←∂→ (∂→ s₁)) (¬∂∂d ltr)     = tranLFCoRem ((s ←∂) ←∂→ s₁) ltr
tranLFCoRem (s ←∂→ (s₁ ←∂→ s₂)) (¬∂∂d ltr) = tranLFCoRem ((s ←∂→ s₁) ←∂→ s₂) ltr

extendLFCoRem : ∀{i u oll orll ll pll} → {olf : LFun {i} {u} oll orll} → IndexLL {i} {u} pll ll → SetLFCoRem {i} olf pll → SetLFCoRem olf ll
extendLFCoRem ↓ sr = sr
extendLFCoRem (ind ←∧) sr = (extendLFCoRem ind sr) ←∧
extendLFCoRem (∧→ ind) sr = ∧→ (extendLFCoRem ind sr)
extendLFCoRem (ind ←∨) sr = (extendLFCoRem ind sr) ←∨
extendLFCoRem (∨→ ind) sr = ∨→ (extendLFCoRem ind sr)
extendLFCoRem (ind ←∂) sr = (extendLFCoRem ind sr) ←∂
extendLFCoRem (∂→ ind) sr = ∂→ (extendLFCoRem ind sr)

replaceLFCoRem : ∀{i u oll orll ll pll rll} → {olf : LFun {i} {u} oll orll} → (ind : IndexLL {i} {u} pll ll) → SetLFCoRem {i} olf rll → SetLFCoRem olf ll → SetLFCoRem olf (replLL ll ind rll)
replaceLFCoRem ↓ esr sr = esr
replaceLFCoRem {rll = rll} (ind ←∧) esr (↓ x) = (extendLFCoRem (updInd rll ind) esr) ←∧
replaceLFCoRem {rll = rll} (ind ←∧) esr (sr ←∧) = replaceLFCoRem ind esr sr ←∧
replaceLFCoRem {rll = rll} (ind ←∧) esr (∧→ sr) = (extendLFCoRem (updInd rll ind) esr) ←∧→ sr
replaceLFCoRem {rll = rll} (ind ←∧) esr (sr ←∧→ sr₁) = (replaceLFCoRem ind esr sr) ←∧→ sr₁
replaceLFCoRem {rll = rll} (∧→ ind) esr (↓ x) = ∧→ (extendLFCoRem (updInd rll ind) esr)
replaceLFCoRem {rll = rll} (∧→ ind) esr (sr ←∧) = sr ←∧→ (extendLFCoRem (updInd rll ind) esr)
replaceLFCoRem {rll = rll} (∧→ ind) esr (∧→ sr) = ∧→ replaceLFCoRem ind esr sr
replaceLFCoRem {rll = rll} (∧→ ind) esr (sr ←∧→ sr₁) = sr ←∧→ replaceLFCoRem ind esr sr₁
replaceLFCoRem {rll = rll} (ind ←∨) esr (↓ x) = (extendLFCoRem (updInd rll ind) esr) ←∨
replaceLFCoRem {rll = rll} (ind ←∨) esr (sr ←∨) = replaceLFCoRem ind esr sr ←∨
replaceLFCoRem {rll = rll} (ind ←∨) esr (∨→ sr) = (extendLFCoRem (updInd rll ind) esr) ←∨→ sr
replaceLFCoRem {rll = rll} (ind ←∨) esr (sr ←∨→ sr₁) = (replaceLFCoRem ind esr sr) ←∨→ sr₁
replaceLFCoRem {rll = rll} (∨→ ind) esr (↓ x) = ∨→ (extendLFCoRem (updInd rll ind) esr)
replaceLFCoRem {rll = rll} (∨→ ind) esr (sr ←∨) = sr ←∨→ (extendLFCoRem (updInd rll ind) esr)
replaceLFCoRem {rll = rll} (∨→ ind) esr (∨→ sr) = ∨→ replaceLFCoRem ind esr sr
replaceLFCoRem {rll = rll} (∨→ ind) esr (sr ←∨→ sr₁) = sr ←∨→ replaceLFCoRem ind esr sr₁
replaceLFCoRem {rll = rll} (ind ←∂) esr (↓ x) = (extendLFCoRem (updInd rll ind) esr) ←∂
replaceLFCoRem {rll = rll} (ind ←∂) esr (sr ←∂) = replaceLFCoRem ind esr sr ←∂
replaceLFCoRem {rll = rll} (ind ←∂) esr (∂→ sr) = (extendLFCoRem (updInd rll ind) esr) ←∂→ sr
replaceLFCoRem {rll = rll} (ind ←∂) esr (sr ←∂→ sr₁) = (replaceLFCoRem ind esr sr) ←∂→ sr₁
replaceLFCoRem {rll = rll} (∂→ ind) esr (↓ x) = ∂→ (extendLFCoRem (updInd rll ind) esr)
replaceLFCoRem {rll = rll} (∂→ ind) esr (sr ←∂) = sr ←∂→ (extendLFCoRem (updInd rll ind) esr)
replaceLFCoRem {rll = rll} (∂→ ind) esr (∂→ sr) = ∂→ replaceLFCoRem ind esr sr
replaceLFCoRem {rll = rll} (∂→ ind) esr (sr ←∂→ sr₁) = sr ←∂→ replaceLFCoRem ind esr sr₁

mreplaceLFCoRem :  ∀{i u oll orll ll pll rll} → {olf : LFun {i} {u} oll orll} → (ind : IndexLL {i} {u} pll ll) → MSetLFCoRem {i} olf rll → MSetLFCoRem olf ll → MSetLFCoRem olf (replLL ll ind rll)
mreplaceLFCoRem ind ∅ ∅ = ∅
mreplaceLFCoRem {rll = rll} ind ∅ (¬∅ x) = delLFCoRem x ind rll
mreplaceLFCoRem {rll = rll} ind (¬∅ x) ∅ = ¬∅ (extendLFCoRem (updInd rll ind) x)
mreplaceLFCoRem ind (¬∅ x) (¬∅ x₁) = ¬∅ (replaceLFCoRem ind x x₁)