open import Relation.Binary.Core

module PLRTree.Push.Complete {A : Set}
                     (_≤_ : A → A → Set)
                     (tot≤ : Total _≤_)  where

open import Data.Sum
open import Induction.WellFounded
open import PLRTree {A}
open import PLRTree.Drop _≤_ tot≤
open import PLRTree.Complete {A}
open import PLRTree.Equality {A}
open import PLRTree.Equality.Properties {A}
open import PLRTree.Order {A}
open import PLRTree.Order.Properties {A}

mutual
  lemma-≃-push : {t t' : PLRTree} → t ≃ t' → (acc : Acc _≺_ t) → t ≃ push t acc
  lemma-≃-push ≃lf _ = ≃lf
  lemma-≃-push (≃nd x x' ≃lf ≃lf ≃lf) _ = ≃nd x x ≃lf ≃lf ≃lf
  lemma-≃-push (≃nd x x' (≃nd {l₁} {r₁} {l₂} {r₂} x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) l'≃r' (≃nd .x₁ x'₁ _ l'₁≃r'₁ l₁≃l'₁)) (acc rs)
      with tot≤ x x₁ | tot≤ x x₂ | tot≤ x₁ x₂
  ... | inj₁ x≤x₁ | inj₁ x≤x₂ | _ =
             let l₁≃l₁ = lemma-≃-≃ l₁≃r₁
             in ≃nd x x (≃nd x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) (≃nd x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) (≃nd x₁ x₁ l₁≃r₁ l₁≃r₁ l₁≃l₁)
  ... | inj₁ x≤x₁ | inj₂ x₂≤x | _ rewrite lemma-≡-height perfect x x₂ l₂ r₂ =
             let acc-xl₂r₂ = rs (node perfect x l₂ r₂) (lemma-≺-right perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  push-xl₁r₁≃x₂l₂r₂ = lemma-≃-push  (sym≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂)) acc-xl₂r₂ ;
                  x₁l₁r₁≃push-xl₂r₂ = trans≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂) push-xl₁r₁≃x₂l₂r₂ ;
                  x₁l₁r₁≃x₁l₁r₁ = lemma-≃-≃ (≃nd x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂)
             in ≃nd x x₂ (≃nd x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) x₁l₁r₁≃push-xl₂r₂ x₁l₁r₁≃x₁l₁r₁
  ... | inj₂ x₁≤x | inj₁ x≤x₂ | _ rewrite lemma-≡-height perfect x x₁ l₁ r₁ =
             let acc-xl₁r₁ = rs (node perfect x l₁ r₁) (lemma-≺-left perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  push-xl₁r₁≃x₂l₂r₂ = trans≃ (lemma-push-≃ (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) acc-xl₁r₁) (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) ;
                  l₁≃l₁ = lemma-≃-≃ l₁≃r₁ ;
                  x₁l₁r₁≃xl₁r₁ = ≃nd x₁ x l₁≃r₁ l₁≃r₁ l₁≃l₁ ;
                  xl₁r₁≃push-xl₁r₁ = lemma-≃-push (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) acc-xl₁r₁ ;
                  x₁l₁r₁≃push-xl₁r₁ = trans≃ x₁l₁r₁≃xl₁r₁ xl₁r₁≃push-xl₁r₁
             in ≃nd x x₁ (≃nd x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) push-xl₁r₁≃x₂l₂r₂ x₁l₁r₁≃push-xl₁r₁
  ... | inj₂ x₁≤x | inj₂ x₂≤x | inj₁ x₁≤x₂ rewrite lemma-≡-height perfect x x₁ l₁ r₁ =
             let acc-xl₁r₁ = rs (node perfect x l₁ r₁) (lemma-≺-left perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  push-xl₁r₁≃x₂l₂r₂ = trans≃ (lemma-push-≃ (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) acc-xl₁r₁) (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) ;
                  l₁≃l₁ = lemma-≃-≃ l₁≃r₁ ;
                  x₁l₁r₁≃xl₁r₁ = ≃nd x₁ x l₁≃r₁ l₁≃r₁ l₁≃l₁ ;
                  xl₁r₁≃push-xl₁r₁ = lemma-≃-push (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) acc-xl₁r₁ ;
                  x₁l₁r₁≃push-xl₁r₁ = trans≃ x₁l₁r₁≃xl₁r₁ xl₁r₁≃push-xl₁r₁
             in ≃nd x x₁ (≃nd x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) push-xl₁r₁≃x₂l₂r₂ x₁l₁r₁≃push-xl₁r₁
  ... | inj₂ x₁≤x | inj₂ x₂≤x | inj₂ x₂≤x₁ rewrite lemma-≡-height perfect x x₂ l₂ r₂ =
             let acc-xl₂r₂ = rs (node perfect x l₂ r₂) (lemma-≺-right perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  push-xl₁r₁≃x₂l₂r₂ = lemma-≃-push  (sym≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂)) acc-xl₂r₂ ;
                  x₁l₁r₁≃push-xl₂r₂ = trans≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂) push-xl₁r₁≃x₂l₂r₂ ;
                  x₁l₁r₁≃x₁l₁r₁ = lemma-≃-≃ (≃nd x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂)
             in ≃nd x x₂ (≃nd x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) x₁l₁r₁≃push-xl₂r₂ x₁l₁r₁≃x₁l₁r₁

  lemma-push-≃ : {t t' : PLRTree} → t ≃ t' → (acc : Acc _≺_ t) → push t acc ≃ t
  lemma-push-≃ t≃t' at = sym≃ (lemma-≃-push t≃t' at)

lemma-push-⋗ : {t t' : PLRTree} → t ⋗ t' → (acc : Acc _≺_ t) → push t acc ⋗ t'
lemma-push-⋗ (⋗lf x) _ = ⋗lf x
lemma-push-⋗ (⋗nd _ _ ≃lf _ ()) _
lemma-push-⋗ (⋗nd x x' (≃nd x₁ x₂ ≃lf ≃lf ≃lf) ≃lf (⋗lf .x₁)) (acc rs)
    with tot≤ x x₁ | tot≤ x x₂ | tot≤ x₁ x₂
... | inj₁ x≤x₁ | inj₁ x≤x₂ | _ = ⋗nd x x' (≃nd x₁ x₂ ≃lf ≃lf ≃lf) ≃lf (⋗lf x₁)
... | inj₁ x≤x₁ | inj₂ x₂≤x | _ = ⋗nd x₂ x' (≃nd x₁ x ≃lf ≃lf ≃lf) ≃lf (⋗lf x₁)
... | inj₂ x₁≤x | inj₁ x≤x₂ | _ = ⋗nd x₁ x' (≃nd x x₂ ≃lf ≃lf ≃lf) ≃lf (⋗lf x)
... | inj₂ x₁≤x | inj₂ x₂≤x | inj₁ x₁≤x₂ = ⋗nd x₁ x' (≃nd x x₂ ≃lf ≃lf ≃lf) ≃lf (⋗lf x)
... | inj₂ x₁≤x | inj₂ x₂≤x | inj₂ x₂≤x₁ = ⋗nd x₂ x' (≃nd x₁ x ≃lf ≃lf ≃lf) ≃lf (⋗lf x₁)
lemma-push-⋗ (⋗nd _ _ (≃nd x₁ _ ≃lf (≃nd _ _ _ _ _) ()) ≃lf (⋗lf .x₁)) _
lemma-push-⋗ (⋗nd x x' (≃nd {l₁} {r₁} {l₂} {r₂} x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) l'≃r' (⋗nd .x₁ x'₁ _ l'₁≃r'₁ l₁⋗l'₁)) (acc rs)
    with tot≤ x x₁ | tot≤ x x₂ | tot≤ x₁ x₂
... | inj₁ x≤x₁ | inj₁ x≤x₂ | _ = ⋗nd x x' (≃nd x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) l'≃r' (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)
... | inj₁ x≤x₁ | inj₂ x₂≤x | _ rewrite lemma-≡-height perfect x x₂ l₂ r₂ =
           let acc-xl₂r₂ = rs (node perfect x l₂ r₂) (lemma-≺-right perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                push-xl₁r₁≃x₂l₂r₂ = lemma-≃-push  (sym≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂)) acc-xl₂r₂ ;
                x₁l₁r₁≃push-xl₂r₂ = trans≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂) push-xl₁r₁≃x₂l₂r₂
           in ⋗nd x₂ x' x₁l₁r₁≃push-xl₂r₂ l'≃r' (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)
... | inj₂ x₁≤x | inj₁ x≤x₂ | _ rewrite lemma-≡-height perfect x x₁ l₁ r₁ =
           let acc-xl₁r₁ = rs (node perfect x l₁ r₁) (lemma-≺-left perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                push-xl₁r₁≃x₂l₂r₂ = trans≃ (lemma-push-≃ (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) acc-xl₁r₁) (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) ;
                push-xl₁r₁⋗x'₁l'₁r'₁ = lemma-push-⋗ (⋗nd x x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁) acc-xl₁r₁
           in ⋗nd x₁ x' push-xl₁r₁≃x₂l₂r₂ l'≃r' push-xl₁r₁⋗x'₁l'₁r'₁
... | inj₂ x₁≤x | inj₂ x₂≤x | inj₁ x₁≤x₂ rewrite lemma-≡-height perfect x x₁ l₁ r₁ =
           let acc-xl₁r₁ = rs (node perfect x l₁ r₁) (lemma-≺-left perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                push-xl₁r₁≃x₂l₂r₂ = trans≃ (lemma-push-≃ (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) acc-xl₁r₁) (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) ;
                push-xl₁r₁⋗x'₁l'₁r'₁ = lemma-push-⋗ (⋗nd x x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁) acc-xl₁r₁
           in ⋗nd x₁ x' push-xl₁r₁≃x₂l₂r₂ l'≃r' push-xl₁r₁⋗x'₁l'₁r'₁
... | inj₂ x₁≤x | inj₂ x₂≤x | inj₂ x₂≤x₁ rewrite lemma-≡-height perfect x x₂ l₂ r₂ =
           let acc-xl₂r₂ = rs (node perfect x l₂ r₂) (lemma-≺-right perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                push-xl₁r₁≃x₂l₂r₂ = lemma-≃-push  (sym≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂)) acc-xl₂r₂ ;
                x₁l₁r₁≃push-xl₂r₂ = trans≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂) push-xl₁r₁≃x₂l₂r₂
           in ⋗nd x₂ x' x₁l₁r₁≃push-xl₂r₂ l'≃r' (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)

lemma-⋗-push : {t t' : PLRTree} → t ⋗ t' → (acc : Acc _≺_ t') → t ⋗ push t' acc
lemma-⋗-push (⋗lf x) _ = ⋗lf x
lemma-⋗-push (⋗nd x x' l≃r ≃lf l⋗l') _ = ⋗nd x x' l≃r ≃lf l⋗l'
lemma-⋗-push (⋗nd x x' l≃r (≃nd {l'₁} {r'₁} {l'₂} {r'₂} x'₁ x'₂  l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) (⋗nd x₁ .x'₁ l₁≃r₁ _ l₁⋗l'₁)) (acc rs)
    with tot≤ x' x'₁ | tot≤ x' x'₂ | tot≤ x'₁ x'₂
... | inj₁ x'≤x'₁ | inj₁ x'≤x'₂ | _ = ⋗nd x x' l≃r (≃nd x'₁ x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)
... | inj₁ x'≤x'₁ | inj₂ x'₂≤x' | _ rewrite lemma-≡-height perfect x' x'₂ l'₂ r'₂ =
           let acc-x'l'₂r'₂ = rs (node perfect x' l'₂ r'₂) (lemma-≺-right perfect x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                x'₁l'₁r'₁≃push-x'l'₂r'₂ = trans≃ (≃nd x'₁ x' l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) (lemma-≃-push (sym≃ (≃nd x'₁ x' l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂)) acc-x'l'₂r'₂)
           in ⋗nd x x'₂ l≃r x'₁l'₁r'₁≃push-x'l'₂r'₂ (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)
... | inj₂ x'₁≤x' | inj₁ x'≤x'₂ | _ rewrite lemma-≡-height perfect x' x'₁ l'₁ r'₁ =
           let acc-x'l'₁r'₁ = rs (node perfect x' l'₁ r'₁) (lemma-≺-left perfect x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                push-x'l'₁r'₁≃x'₂l'₂r'₂ = trans≃ (lemma-push-≃ (≃nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) acc-x'l'₁r'₁) (≃nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) ;
                x₁l₁r₁⋗push-x'l'₁r'₁ = lemma-⋗-push (⋗nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁) acc-x'l'₁r'₁
           in ⋗nd x x'₁ l≃r push-x'l'₁r'₁≃x'₂l'₂r'₂ x₁l₁r₁⋗push-x'l'₁r'₁
... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₁ x'₁≤x'₂ rewrite lemma-≡-height perfect x' x'₁ l'₁ r'₁ =
           let acc-x'l'₁r'₁ = rs (node perfect x' l'₁ r'₁) (lemma-≺-left perfect x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                push-x'l'₁r'₁≃x'₂l'₂r'₂ = trans≃ (lemma-push-≃ (≃nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) acc-x'l'₁r'₁) (≃nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) ;
                x₁l₁r₁⋗push-x'l'₁r'₁ = lemma-⋗-push (⋗nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁) acc-x'l'₁r'₁
           in ⋗nd x x'₁ l≃r push-x'l'₁r'₁≃x'₂l'₂r'₂ x₁l₁r₁⋗push-x'l'₁r'₁
... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₂ x'₂≤x'₁ rewrite lemma-≡-height perfect x' x'₂ l'₂ r'₂ =
           let acc-x'l'₂r'₂ = rs (node perfect x' l'₂ r'₂) (lemma-≺-right perfect x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                x'₁l'₁r'₁≃push-x'l'₂r'₂ = trans≃ (≃nd x'₁ x' l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) (lemma-≃-push (sym≃ (≃nd x'₁ x' l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂)) acc-x'l'₂r'₂)
           in ⋗nd x x'₂ l≃r x'₁l'₁r'₁≃push-x'l'₂r'₂ (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)

lemma-⋘-push : {t t' : PLRTree} → t ⋘ t' → (acc : Acc _≺_ t') → t ⋘ push t' acc
lemma-⋘-push (x⋘ x y z) _ = x⋘ x y z
lemma-⋘-push (l⋘ _ _ () ≃lf ≃lf) _
lemma-⋘-push (l⋘ x x' l⋘r (≃nd {l'₁} {r'₁} {l'₂} {r'₂} x'₁ x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) (≃nd x₂ .x'₁ l₂≃r₂ _ l₂≃l'₁)) (acc rs)
    with tot≤ x' x'₁ | tot≤ x' x'₂ | tot≤ x'₁ x'₂
... | inj₁ x'≤x'₁ | inj₁ x'≤x'₂ | _ = l⋘ x x' l⋘r (≃nd x'₁ x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) (≃nd x₂ x'₁ l₂≃r₂ l'₁≃r'₁ l₂≃l'₁)
... | inj₁ x'≤x'₁ | inj₂ x'₂≤x' | _ rewrite lemma-≡-height perfect x' x'₂ l'₂ r'₂ =
           let acc-x'l'₂r'₂ = rs (node perfect x' l'₂ r'₂) (lemma-≺-right perfect x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                x'₁l'₁r'₁≃push-x'l'₂r'₂ = trans≃ (≃nd x'₁ x' l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) (lemma-≃-push (sym≃ (≃nd x'₁ x' l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂)) acc-x'l'₂r'₂)
           in l⋘ x x'₂ l⋘r x'₁l'₁r'₁≃push-x'l'₂r'₂ (≃nd x₂ x'₁ l₂≃r₂ l'₁≃r'₁ l₂≃l'₁)
... | inj₂ x'₁≤x' | inj₁ x'≤x'₂ | _ rewrite lemma-≡-height perfect x' x'₁ l'₁ r'₁ =
           let acc-x'l'₁r'₁ = rs (node perfect x' l'₁ r'₁) (lemma-≺-left perfect x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                push-x'l'₁r'₁≃x'₂l'₂r'₂ = trans≃ (lemma-push-≃ (≃nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) acc-x'l'₁r'₁) (≃nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) ;
                x₂l₂r₂≃push-x'l'₁r'₁ = trans≃ (≃nd x₂ x' l₂≃r₂ l'₁≃r'₁ l₂≃l'₁) (lemma-≃-push (≃nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) acc-x'l'₁r'₁)
           in l⋘ x x'₁ l⋘r push-x'l'₁r'₁≃x'₂l'₂r'₂ x₂l₂r₂≃push-x'l'₁r'₁
... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₁ x'₁≤x'₂ rewrite lemma-≡-height perfect x' x'₁ l'₁ r'₁ =
           let acc-x'l'₁r'₁ = rs (node perfect x' l'₁ r'₁) (lemma-≺-left perfect x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                push-x'l'₁r'₁≃x'₂l'₂r'₂ = trans≃ (lemma-push-≃ (≃nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) acc-x'l'₁r'₁) (≃nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) ;
                x₂l₂r₂≃push-x'l'₁r'₁ = trans≃ (≃nd x₂ x' l₂≃r₂ l'₁≃r'₁ l₂≃l'₁) (lemma-≃-push (≃nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) acc-x'l'₁r'₁)
           in l⋘ x x'₁ l⋘r push-x'l'₁r'₁≃x'₂l'₂r'₂ x₂l₂r₂≃push-x'l'₁r'₁
... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₂ x'₂≤x'₁ rewrite lemma-≡-height perfect x' x'₂ l'₂ r'₂ =
           let acc-x'l'₂r'₂ = rs (node perfect x' l'₂ r'₂) (lemma-≺-right perfect x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                x'₁l'₁r'₁≃push-x'l'₂r'₂ = trans≃ (≃nd x'₁ x' l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) (lemma-≃-push (sym≃ (≃nd x'₁ x' l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂)) acc-x'l'₂r'₂)
           in l⋘ x x'₂ l⋘r x'₁l'₁r'₁≃push-x'l'₂r'₂ (≃nd x₂ x'₁ l₂≃r₂ l'₁≃r'₁ l₂≃l'₁)
lemma-⋘-push (r⋘ x x' l⋙r ≃lf (⋗lf x₁)) _ = r⋘ x x' l⋙r ≃lf (⋗lf x₁)
lemma-⋘-push (r⋘ x x' l⋙r (≃nd {l'₁} {r'₁} {l'₂} {r'₂} x'₁ x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) (⋗nd x₁ .x'₁ l₁≃r₁ _ l₁⋗l'₁)) (acc rs)
    with tot≤ x' x'₁ | tot≤ x' x'₂ | tot≤ x'₁ x'₂
... | inj₁ x'≤x'₁ | inj₁ x'≤x'₂ | _ = r⋘ x x' l⋙r (≃nd x'₁ x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)
... | inj₁ x'≤x'₁ | inj₂ x'₂≤x' | _ rewrite lemma-≡-height perfect x' x'₂ l'₂ r'₂ =
           let acc-x'l'₂r'₂ = rs (node perfect x' l'₂ r'₂) (lemma-≺-right perfect x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                x'₁l'₁r'₁≃push-x'l'₂r'₂ = trans≃ (≃nd x'₁ x' l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) (lemma-≃-push (sym≃ (≃nd x'₁ x' l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂)) acc-x'l'₂r'₂)
           in r⋘ x x'₂ l⋙r  x'₁l'₁r'₁≃push-x'l'₂r'₂ (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)
... | inj₂ x'₁≤x' | inj₁ x'≤x'₂ | _ rewrite lemma-≡-height perfect x' x'₁ l'₁ r'₁ =
           let acc-x'l'₁r'₁ = rs (node perfect x' l'₁ r'₁) (lemma-≺-left perfect x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                push-x'l'₁r'₁≃x'₂l'₂r'₂ = trans≃ (lemma-push-≃ (≃nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) acc-x'l'₁r'₁) (≃nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂)
           in r⋘ x x'₁ l⋙r push-x'l'₁r'₁≃x'₂l'₂r'₂ (lemma-⋗-push (⋗nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁) acc-x'l'₁r'₁)
... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₁ x'₁≤x'₂ rewrite lemma-≡-height perfect x' x'₁ l'₁ r'₁ =
           let acc-x'l'₁r'₁ = rs (node perfect x' l'₁ r'₁) (lemma-≺-left perfect x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                push-x'l'₁r'₁≃x'₂l'₂r'₂ = trans≃ (lemma-push-≃ (≃nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂)  acc-x'l'₁r'₁) (≃nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂)
           in r⋘ x x'₁ l⋙r push-x'l'₁r'₁≃x'₂l'₂r'₂ (lemma-⋗-push (⋗nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁) acc-x'l'₁r'₁)
... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₂ x'₂≤x'₁ rewrite lemma-≡-height perfect x' x'₂ l'₂ r'₂ =
           let acc-x'l'₂r'₂ = rs (node perfect x' l'₂ r'₂) (lemma-≺-right perfect x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                x'₁l'₁r'₁≃push-x'l'₂r'₂ = trans≃ (≃nd x'₁ x' l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂) (lemma-≃-push (sym≃ (≃nd x'₁ x' l'₁≃r'₁ l'₂≃r'₂ l'₁≃l'₂)) acc-x'l'₂r'₂)
           in r⋘ x x'₂ l⋙r  x'₁l'₁r'₁≃push-x'l'₂r'₂ (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)

lemma-push-⋙ : {t t' : PLRTree} → t ⋙ t' → (acc : Acc _≺_ t) → push t acc ⋙ t'
lemma-push-⋙ (⋙p l⋗r) (acc rs) = ⋙p (lemma-push-⋗ l⋗r (acc rs))
lemma-push-⋙ (⋙l _ _ ≃lf _ ()) _
lemma-push-⋙ (⋙l _ _ (≃nd x₁ _ ≃lf _ _) () (⋗lf .x₁)) _
lemma-push-⋙ (⋙l x x' (≃nd {l₁} {r₁} {l₂} {r₂} x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) l'⋘r' (⋗nd .x₁ x₄ _ l₄≃r₄ l₁⋗r₄)) (acc rs)
    with tot≤ x x₁ | tot≤ x x₂ | tot≤ x₁ x₂
... | inj₁ x≤x₁ | inj₁ x≤x₂ | _ = ⋙l x x' (≃nd x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) l'⋘r' (⋗nd x₁ x₄ l₁≃r₁ l₄≃r₄ l₁⋗r₄)
... | inj₁ x≤x₁ | inj₂ x₂≤x | _ rewrite lemma-≡-height perfect x x₂ l₂ r₂ =
           let acc-xl₂r₂ = rs (node perfect x l₂ r₂) (lemma-≺-right perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                x₁l₁r₁≃push-xl₂r₂ = trans≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂) (lemma-≃-push  (sym≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂)) acc-xl₂r₂)
           in ⋙l x₂ x' x₁l₁r₁≃push-xl₂r₂ l'⋘r' (⋗nd x₁ x₄ l₁≃r₁ l₄≃r₄ l₁⋗r₄)
... | inj₂ x₁≤x | inj₁ x≤x₂ | _ rewrite lemma-≡-height perfect x x₁ l₁ r₁ =
           let acc-xl₁r₁ = rs (node perfect x l₁ r₁) (lemma-≺-left perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                push-xl₁r₁≃x₂l₂r₂ = trans≃ (lemma-push-≃ (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) acc-xl₁r₁) (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂)
           in ⋙l x₁ x' push-xl₁r₁≃x₂l₂r₂ l'⋘r' (lemma-push-⋗ (⋗nd x x₄ l₁≃r₁ l₄≃r₄ l₁⋗r₄) acc-xl₁r₁)
... | inj₂ x₁≤x | inj₂ x₂≤x | inj₁ x₁≤x₂ rewrite lemma-≡-height perfect x x₁ l₁ r₁ =
           let acc-xl₁r₁ = rs (node perfect x l₁ r₁) (lemma-≺-left perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                push-xl₁r₁≃x₂l₂r₂ = trans≃ (lemma-push-≃ (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) acc-xl₁r₁) (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂)
           in ⋙l x₁ x' push-xl₁r₁≃x₂l₂r₂ l'⋘r' (lemma-push-⋗ (⋗nd x x₄ l₁≃r₁ l₄≃r₄ l₁⋗r₄) acc-xl₁r₁)
... | inj₂ x₁≤x | inj₂ x₂≤x | inj₂ x₂≤x₁ rewrite lemma-≡-height perfect x x₂ l₂ r₂ =
           let acc-xl₂r₂ = rs (node perfect x l₂ r₂) (lemma-≺-right perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                x₁l₁r₁≃push-xl₂r₂ =  trans≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂) (lemma-≃-push  (sym≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂)) acc-xl₂r₂)
           in ⋙l x₂ x' x₁l₁r₁≃push-xl₂r₂ l'⋘r' (⋗nd x₁ x₄ l₁≃r₁ l₄≃r₄ l₁⋗r₄)
lemma-push-⋙ (⋙r _ _ ≃lf (⋙p ()) ≃lf) _
lemma-push-⋙ (⋙r x x' (≃nd {l₁} {r₁} {l₂} {r₂} x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) l'⋙r' (≃nd .x₁ x₃ _ l₃≃r₃ l₁≃l₃)) (acc rs)
    with tot≤ x x₁ | tot≤ x x₂ | tot≤ x₁ x₂
... | inj₁ x≤x₁ | inj₁ x≤x₂ | _ = ⋙r x x' (≃nd x₁ x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) l'⋙r' (≃nd x₁ x₃ l₁≃r₁ l₃≃r₃ l₁≃l₃)
... | inj₁ x≤x₁ | inj₂ x₂≤x | _ rewrite lemma-≡-height perfect x x₂ l₂ r₂ =
           let acc-xl₂r₂ = rs (node perfect x l₂ r₂) (lemma-≺-right perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                x₁l₁r₁≃push-xl₂r₂ = trans≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂) (lemma-≃-push (sym≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂)) acc-xl₂r₂)
           in ⋙r x₂ x' x₁l₁r₁≃push-xl₂r₂ l'⋙r' (≃nd x₁ x₃ l₁≃r₁ l₃≃r₃ l₁≃l₃)
... | inj₂ x₁≤x | inj₁ x≤x₂ | _ rewrite lemma-≡-height perfect x x₁ l₁ r₁ =
           let acc-xl₁r₁ = rs (node perfect x l₁ r₁) (lemma-≺-left perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                push-xl₁r₁≃x₂l₂r₂ = trans≃ (lemma-push-≃ (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) acc-xl₁r₁) (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) ;
                push-xl₁r₁≃x₃l₃r₃ = trans≃ (lemma-push-≃ (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) acc-xl₁r₁) (≃nd x x₃ l₁≃r₁ l₃≃r₃ l₁≃l₃)
           in ⋙r x₁ x' push-xl₁r₁≃x₂l₂r₂ l'⋙r' push-xl₁r₁≃x₃l₃r₃
... | inj₂ x₁≤x | inj₂ x₂≤x | inj₁ x₁≤x₂ rewrite lemma-≡-height perfect x x₁ l₁ r₁ =
           let acc-xl₁r₁ = rs (node perfect x l₁ r₁) (lemma-≺-left perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                push-xl₁r₁≃x₂l₂r₂ = trans≃ (lemma-push-≃ (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) acc-xl₁r₁) (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) ;
                push-xl₁r₁≃x₃l₃r₃ = trans≃ (lemma-push-≃ (≃nd x x₂ l₁≃r₁ l₂≃r₂ l₁≃l₂) acc-xl₁r₁) (≃nd x x₃ l₁≃r₁ l₃≃r₃ l₁≃l₃)
           in ⋙r x₁ x' push-xl₁r₁≃x₂l₂r₂ l'⋙r' push-xl₁r₁≃x₃l₃r₃
... | inj₂ x₁≤x | inj₂ x₂≤x | inj₂ x₂≤x₁ rewrite lemma-≡-height perfect x x₂ l₂ r₂ =
           let acc-xl₂r₂ = rs (node perfect x l₂ r₂) (lemma-≺-right perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                x₁l₁r₁≃push-xl₂r₂ = trans≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂) (lemma-≃-push (sym≃ (≃nd x₁ x l₁≃r₁ l₂≃r₂ l₁≃l₂)) acc-xl₂r₂)
           in ⋙r x₂ x' x₁l₁r₁≃push-xl₂r₂ l'⋙r' (≃nd x₁ x₃ l₁≃r₁ l₃≃r₃ l₁≃l₃)

mutual
  lemma-⋙r-push : {l r l' r' : PLRTree}(x x' : A) → l ≃ r → l' ⋙ r' → l ≃ l' → (acc : Acc _≺_ (node right x' l' r')) → (node perfect x l r) ⋙ push (node right x' l' r') acc
  lemma-⋙r-push x x' l≃r (⋙p (⋗lf x'₁)) (≃nd x₁ .x'₁ ≃lf ≃lf ≃lf) (acc rs)
      with tot≤ x' x'₁
  ... | inj₁ x'≤x'₁ = ⋙r x x' l≃r (⋙p (⋗lf x'₁)) (≃nd x₁ x'₁ ≃lf ≃lf ≃lf)
  ... | inj₂ x'₁≤x' = ⋙r x x'₁ l≃r (⋙p (⋗lf x')) (≃nd x₁ x' ≃lf ≃lf ≃lf)
  lemma-⋙r-push x x' l≃r (⋙p (⋗nd {l'₁} {r'₁} {l'₂} {r'₂} x'₁ x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁⋗l'₂)) (≃nd x₁ .x'₁ l₁≃r₁ _ l₁≃l'₁) (acc rs)
        with tot≤ x' x'₁ | tot≤ x' x'₂ | tot≤ x'₁ x'₂
  ... | inj₁ x'≤x'₁ | inj₁ x'≤x'₂ | _ = ⋙r x x' l≃r (⋙p (⋗nd x'₁ x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁⋗l'₂)) (≃nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)
  ... | inj₁ x'≤x'₁ | inj₂ x'₂≤x' | _ rewrite lemma-≡-height perfect x' x'₂ l'₂ r'₂  =
             let acc-x'l'₂r'₂ = rs (node perfect x' l'₂ r'₂) (lemma-≺-right right x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                  x'₁l'₁r'₁⋗push-x'l'₂r'₂ = lemma-⋗-push (⋗nd x'₁ x' l'₁≃r'₁ l'₂≃r'₂ l'₁⋗l'₂) acc-x'l'₂r'₂
             in ⋙r x x'₂ l≃r (⋙p x'₁l'₁r'₁⋗push-x'l'₂r'₂) (≃nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)
  ... | inj₂ x'₁≤x' | inj₁ x'≤x'₂ | _ rewrite lemma-≡-height perfect x' x'₁ l'₁ r'₁ =
             let acc-x'l'₁r'₁ = rs (node perfect x' l'₁ r'₁) (lemma-≺-left right x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                  push-x'l'₁r'₁⋗x'₂l'₂r'₂ = lemma-push-⋗ (⋗nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁⋗l'₂) acc-x'l'₁r'₁ ;
                  x₁l₁r₁≃push-x'l'₁r'₁ = trans≃ (≃nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁≃l'₁) (lemma-≃-push (sym≃ (≃nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)) acc-x'l'₁r'₁)
             in ⋙r x x'₁ l≃r (⋙p push-x'l'₁r'₁⋗x'₂l'₂r'₂) x₁l₁r₁≃push-x'l'₁r'₁
  ... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₁ x'₁≤x'₂ rewrite lemma-≡-height perfect x' x'₁ l'₁ r'₁ =
             let acc-x'l'₁r'₁ = rs (node perfect x' l'₁ r'₁) (lemma-≺-left right x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                  push-x'l'₁r'₁⋗x'₂l'₂r'₂ = lemma-push-⋗ (⋗nd x' x'₂ l'₁≃r'₁ l'₂≃r'₂ l'₁⋗l'₂) acc-x'l'₁r'₁ ;
                  x₁l₁r₁≃push-x'l'₁r'₁ = trans≃ (≃nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁≃l'₁) (lemma-≃-push (sym≃ (≃nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)) acc-x'l'₁r'₁)
             in ⋙r x x'₁ l≃r (⋙p push-x'l'₁r'₁⋗x'₂l'₂r'₂) x₁l₁r₁≃push-x'l'₁r'₁
  ... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₂ x'₂≤x'₁ rewrite lemma-≡-height perfect x' x'₂ l'₂ r'₂ =
             let acc-x'l'₂r'₂ = rs (node perfect x' l'₂ r'₂) (lemma-≺-right right x' (node perfect x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                  x'₁l'₁r'₁⋗push-x'l'₂r'₂ = lemma-⋗-push (⋗nd x'₁ x' l'₁≃r'₁ l'₂≃r'₂ l'₁⋗l'₂) acc-x'l'₂r'₂
             in ⋙r x x'₂ l≃r (⋙p x'₁l'₁r'₁⋗push-x'l'₂r'₂) (≃nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)
  lemma-⋙r-push x x' l≃r (⋙l {l'₁} {r'₁} {l'₂} {r'₂} x'₁ x'₂ l'₁≃r'₁ l'₂⋘r'₂ l'₁⋗r'₂) (≃nd x₁ .x'₁ l₁≃r₁ _ l₁≃l'₁) (acc rs)
        with tot≤ x' x'₁ | tot≤ x' x'₂ | tot≤ x'₁ x'₂
  ... | inj₁ x'≤x'₁ | inj₁ x'≤x'₂ | _ = ⋙r x x' l≃r (⋙l x'₁ x'₂ l'₁≃r'₁ l'₂⋘r'₂ l'₁⋗r'₂) (≃nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)
  ... | inj₁ x'≤x'₁ | inj₂ x'₂≤x' | _ rewrite lemma-≡-height left x' x'₂ l'₂ r'₂  =
             let acc-x'l'₂r'₂ = rs (node left x' l'₂ r'₂) (lemma-≺-right right x' (node perfect x'₁ l'₁ r'₁) (node left x'₂ l'₂ r'₂)) ;
                  x'₁l'₁r'₁⋙push-x'l'₂r'₂ = lemma-⋙l-push x'₁ x' l'₁≃r'₁ l'₂⋘r'₂ l'₁⋗r'₂ acc-x'l'₂r'₂
             in ⋙r x x'₂ l≃r  x'₁l'₁r'₁⋙push-x'l'₂r'₂ (≃nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)
  ... | inj₂ x'₁≤x' | inj₁ x'≤x'₂ | _ rewrite lemma-≡-height perfect x' x'₁ l'₁ r'₁ =
             let acc-x'l'₁r'₁ = rs (node perfect x' l'₁ r'₁) (lemma-≺-left right x' (node perfect x'₁ l'₁ r'₁) (node left x'₂ l'₂ r'₂)) ;
                  push-x'l'₁r'₁⋙x'₂l'₂r'₂ = lemma-push-⋙ (⋙l x' x'₂ l'₁≃r'₁ l'₂⋘r'₂ l'₁⋗r'₂) acc-x'l'₁r'₁ ;
                  x₁l₁r₁≃push-x'l'₁r'₁ = trans≃ (≃nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁≃l'₁) (lemma-≃-push (sym≃ (≃nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)) acc-x'l'₁r'₁)
             in ⋙r x x'₁ l≃r push-x'l'₁r'₁⋙x'₂l'₂r'₂ x₁l₁r₁≃push-x'l'₁r'₁
  ... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₁ x'₁≤x'₂ rewrite lemma-≡-height perfect x' x'₁ l'₁ r'₁ =
             let acc-x'l'₁r'₁ = rs (node perfect x' l'₁ r'₁) (lemma-≺-left right x' (node perfect x'₁ l'₁ r'₁) (node left x'₂ l'₂ r'₂)) ;
                  push-x'l'₁r'₁⋙x'₂l'₂r'₂ = lemma-push-⋙ (⋙l x' x'₂ l'₁≃r'₁ l'₂⋘r'₂ l'₁⋗r'₂) acc-x'l'₁r'₁ ;
                  x₁l₁r₁≃push-x'l'₁r'₁ = trans≃ (≃nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁≃l'₁) (lemma-≃-push (sym≃ (≃nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)) acc-x'l'₁r'₁)
             in ⋙r x x'₁ l≃r push-x'l'₁r'₁⋙x'₂l'₂r'₂ x₁l₁r₁≃push-x'l'₁r'₁
  ... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₂ x'₂≤x'₁ rewrite lemma-≡-height left x' x'₂ l'₂ r'₂ =
             let acc-x'l'₂r'₂ = rs (node left x' l'₂ r'₂) (lemma-≺-right right x' (node perfect x'₁ l'₁ r'₁) (node left x'₂ l'₂ r'₂)) ;
                  x'₁l'₁r'₁⋙push-x'l'₂r'₂ = lemma-⋙l-push x'₁ x' l'₁≃r'₁ l'₂⋘r'₂ l'₁⋗r'₂ acc-x'l'₂r'₂
             in ⋙r x x'₂ l≃r  x'₁l'₁r'₁⋙push-x'l'₂r'₂ (≃nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)

  lemma-⋙r-push x x' l≃r (⋙r {l'₁} {r'₁} {l'₂} {r'₂} x'₁ x'₂ l'₁≃r'₁ l'₂⋙r'₂ l'₁≃l'₂) (≃nd x₁ .x'₁ l₁≃r₁ _ l₁≃l'₁) (acc rs)
        with tot≤ x' x'₁ | tot≤ x' x'₂ | tot≤ x'₁ x'₂
  ... | inj₁ x'≤x'₁ | inj₁ x'≤x'₂ | _ = ⋙r x x' l≃r (⋙r x'₁ x'₂ l'₁≃r'₁ l'₂⋙r'₂ l'₁≃l'₂) (≃nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)
  ... | inj₁ x'≤x'₁ | inj₂ x'₂≤x' | _ rewrite lemma-≡-height right x' x'₂ l'₂ r'₂  =
             let acc-x'l'₂r'₂ = rs (node right x' l'₂ r'₂) (lemma-≺-right right x' (node perfect x'₁ l'₁ r'₁) (node right x'₂ l'₂ r'₂)) ;
                  x'₁l'₁r'₁⋙push-x'l'₂r'₂ = lemma-⋙r-push x'₁ x' l'₁≃r'₁ l'₂⋙r'₂ l'₁≃l'₂ acc-x'l'₂r'₂
             in ⋙r x x'₂ l≃r x'₁l'₁r'₁⋙push-x'l'₂r'₂ (≃nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)
  ... | inj₂ x'₁≤x' | inj₁ x'≤x'₂ | _ rewrite lemma-≡-height perfect x' x'₁ l'₁ r'₁ =
             let acc-x'l'₁r'₁ = rs (node perfect x' l'₁ r'₁) (lemma-≺-left right x' (node perfect x'₁ l'₁ r'₁) (node right x'₂ l'₂ r'₂)) ;
                  push-x'l'₁r'₁⋙x'₂l'₂r'₂ = lemma-push-⋙ (⋙r x' x'₂ l'₁≃r'₁ l'₂⋙r'₂ l'₁≃l'₂) acc-x'l'₁r'₁ ;
                  x₁l₁r₁≃push-x'l'₁r'₁ = trans≃ (≃nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁≃l'₁) (lemma-≃-push (sym≃ (≃nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)) acc-x'l'₁r'₁)
             in ⋙r x x'₁ l≃r push-x'l'₁r'₁⋙x'₂l'₂r'₂ x₁l₁r₁≃push-x'l'₁r'₁
  ... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₁ x'₁≤x'₂ rewrite lemma-≡-height perfect x' x'₁ l'₁ r'₁ =
             let acc-x'l'₁r'₁ = rs (node perfect x' l'₁ r'₁) (lemma-≺-left right x' (node perfect x'₁ l'₁ r'₁) (node right x'₂ l'₂ r'₂)) ;
                  push-x'l'₁r'₁⋙x'₂l'₂r'₂ = lemma-push-⋙ (⋙r x' x'₂ l'₁≃r'₁ l'₂⋙r'₂ l'₁≃l'₂) acc-x'l'₁r'₁ ;
                  x₁l₁r₁≃push-x'l'₁r'₁ = trans≃ (≃nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁≃l'₁) (lemma-≃-push (sym≃ (≃nd x₁ x' l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)) acc-x'l'₁r'₁)
             in ⋙r x x'₁ l≃r push-x'l'₁r'₁⋙x'₂l'₂r'₂ x₁l₁r₁≃push-x'l'₁r'₁
  ... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₂ x'₂≤x'₁ rewrite lemma-≡-height right x' x'₂ l'₂ r'₂ =
             let acc-x'l'₂r'₂ = rs (node right x' l'₂ r'₂) (lemma-≺-right right x' (node perfect x'₁ l'₁ r'₁) (node right x'₂ l'₂ r'₂)) ;
                  x'₁l'₁r'₁⋙push-x'l'₂r'₂ = lemma-⋙r-push x'₁ x' l'₁≃r'₁ l'₂⋙r'₂ l'₁≃l'₂ acc-x'l'₂r'₂
             in ⋙r x x'₂ l≃r x'₁l'₁r'₁⋙push-x'l'₂r'₂ (≃nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁≃l'₁)

  lemma-push-l⋘ : {l r l' r' : PLRTree}(x x' : A) → l ⋘ r → l' ≃ r' → r ≃ l' → (acc : Acc _≺_ (node left x l r)) → push (node left x l r) acc ⋘ node perfect x' l' r'
  lemma-push-l⋘ x x' (x⋘ x₁ x₂ x₃) l'≃r' (≃nd .x₃ x'₁ ≃lf ≃lf ≃lf) (acc rs)
      with tot≤ x x₁ | tot≤ x x₃ | tot≤ x₁ x₃
  ... | inj₁ x≤x₁ | inj₁ x≤x₃ | _ = l⋘ x x' (x⋘ x₁ x₂ x₃) l'≃r' (≃nd x₃ x'₁ ≃lf ≃lf ≃lf)
  ... | inj₁ x≤x₁ | inj₂ x₃≤x | _ = l⋘ x₃ x' (x⋘ x₁ x₂ x) l'≃r' (≃nd x x'₁ ≃lf ≃lf ≃lf)
  ... | inj₂ x₁≤x | inj₁ x≤x₃ | _
      with tot≤ x x₂
  ... | inj₁ x≤x₂ = l⋘ x₁ x' (x⋘ x x₂ x₃) l'≃r' (≃nd x₃ x'₁ ≃lf ≃lf ≃lf)
  ... | inj₂ x₂≤x = l⋘ x₁ x' (x⋘ x₂ x x₃) l'≃r' (≃nd x₃ x'₁ ≃lf ≃lf ≃lf)
  lemma-push-l⋘ x x' (x⋘ x₁ x₂ x₃) l'≃r' (≃nd .x₃ x'₁ ≃lf ≃lf ≃lf) (acc rs) | inj₂ x₁≤x | inj₂ x₃≤x | inj₁ x₁≤x₃
      with tot≤ x x₂
  ... | inj₁ x≤x₂ = l⋘ x₁ x' (x⋘ x x₂ x₃) l'≃r' (≃nd x₃ x'₁ ≃lf ≃lf ≃lf)
  ... | inj₂ x₂≤x = l⋘ x₁ x' (x⋘ x₂ x x₃) l'≃r' (≃nd x₃ x'₁ ≃lf ≃lf ≃lf)
  lemma-push-l⋘ x x' (x⋘ x₁ x₂ x₃) l'≃r' (≃nd .x₃ x'₁ ≃lf ≃lf ≃lf) (acc rs) | inj₂ x₁≤x | inj₂ x₃≤x | inj₂ x₃≤x₁ = l⋘ x₃ x' (x⋘ x₁ x₂ x) l'≃r' (≃nd x x'₁ ≃lf ≃lf ≃lf)
  lemma-push-l⋘ x x' (l⋘ {l₁} {r₁} {l₂} {r₂} x₁ x₂ l₁⋘r₁ l₂≃r₂ r₁≃l₂) l'≃r' (≃nd .x₂ x'₁ _ l'₁≃r'₁ r₂≃l'₁) (acc rs)
      with tot≤ x x₁ | tot≤ x x₂ | tot≤ x₁ x₂
  ... | inj₁ x≤x₁ | inj₁ x≤x₂ | _ = l⋘ x x' (l⋘ x₁ x₂ l₁⋘r₁ l₂≃r₂ r₁≃l₂) l'≃r' (≃nd x₂ x'₁ l₂≃r₂ l'₁≃r'₁ r₂≃l'₁)
  ... | inj₁ x≤x₁ | inj₂ x₂≤x | _ rewrite lemma-≡-height perfect x x₂ l₂ r₂ =
             let acc-xl₂r₂ = rs (node perfect x l₂ r₂) (lemma-≺-right left x (node left x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  x₁l₁r₁⋘push-xl₂r₂ = lemma-⋘-push (l⋘ x₁ x l₁⋘r₁ l₂≃r₂ r₁≃l₂) acc-xl₂r₂ ;
                  push-xl₂r₂≃x'₁l'₁r'₁ = trans≃ (lemma-push-≃ (≃nd x x'₁ l₂≃r₂ l'₁≃r'₁ r₂≃l'₁) acc-xl₂r₂) (≃nd x x'₁ l₂≃r₂ l'₁≃r'₁ r₂≃l'₁)
             in l⋘ x₂ x' x₁l₁r₁⋘push-xl₂r₂ l'≃r' push-xl₂r₂≃x'₁l'₁r'₁
  ... | inj₂ x₁≤x | inj₁ x≤x₂ | _ rewrite lemma-≡-height left x x₁ l₁ r₁ =
             let acc-xl₁r₁ = rs (node left x l₁ r₁) (lemma-≺-left left x (node left x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  push-xl₁r₁⋘x₂l₂r₂ = lemma-push-l⋘ x x₂ l₁⋘r₁ l₂≃r₂ r₁≃l₂ acc-xl₁r₁
             in l⋘ x₁ x' push-xl₁r₁⋘x₂l₂r₂ l'≃r' (≃nd x₂ x'₁ l₂≃r₂ l'₁≃r'₁ r₂≃l'₁)
  ... | inj₂ x₁≤x | inj₂ x₂≤x | inj₁ x₁≤x₂ rewrite lemma-≡-height left x x₁ l₁ r₁ =
             let acc-xl₁r₁ = rs (node left x l₁ r₁) (lemma-≺-left left x (node left x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  push-xl₁r₁⋘x₂l₂r₂ = lemma-push-l⋘ x x₂ l₁⋘r₁ l₂≃r₂ r₁≃l₂ acc-xl₁r₁
             in l⋘ x₁ x' push-xl₁r₁⋘x₂l₂r₂ l'≃r' (≃nd x₂ x'₁ l₂≃r₂ l'₁≃r'₁ r₂≃l'₁)
  ... | inj₂ x₁≤x | inj₂ x₂≤x | inj₂ x₂≤x₁ rewrite lemma-≡-height perfect x x₂ l₂ r₂ =
             let acc-xl₂r₂ = rs (node perfect x l₂ r₂) (lemma-≺-right left x (node left x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  x₁l₁r₁⋘push-xl₂r₂ = lemma-⋘-push (l⋘ x₁ x l₁⋘r₁ l₂≃r₂ r₁≃l₂) acc-xl₂r₂ ;
                  push-xl₂r₂≃x'₁l'₁r'₁ = trans≃ (lemma-push-≃ (≃nd x x'₁ l₂≃r₂ l'₁≃r'₁ r₂≃l'₁) acc-xl₂r₂) (≃nd x x'₁ l₂≃r₂ l'₁≃r'₁ r₂≃l'₁)
             in l⋘ x₂ x' x₁l₁r₁⋘push-xl₂r₂ l'≃r' push-xl₂r₂≃x'₁l'₁r'₁
  lemma-push-l⋘ x x' (r⋘ {l₁} {r₁} {l₂} {r₂} x₁ x₂ l₁⋙r₁ l₂≃r₂ l₁⋗l₂) l'≃r' (≃nd .x₂ x'₁ _ l'₁≃r'₁ r₂≃l'₁) (acc rs)
    with tot≤ x x₁ | tot≤ x x₂ | tot≤ x₁ x₂
  ... | inj₁ x≤x₁ | inj₁ x≤x₂ | _ = l⋘ x x' (r⋘ x₁ x₂ l₁⋙r₁ l₂≃r₂ l₁⋗l₂) l'≃r' (≃nd x₂ x'₁ l₂≃r₂ l'₁≃r'₁ r₂≃l'₁)
  ... | inj₁ x≤x₁ | inj₂ x₂≤x | _ rewrite lemma-≡-height perfect x x₂ l₂ r₂ =
             let acc-xl₂r₂ = rs (node perfect x l₂ r₂) (lemma-≺-right left x (node right x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  x₁l₁r₁⋘push-xl₂r₂ = lemma-⋘-push (r⋘ x₁ x l₁⋙r₁ l₂≃r₂ l₁⋗l₂) acc-xl₂r₂ ;
                  push-xl₂r₂≃x'₁l'₁r'₁ = trans≃ (lemma-push-≃ (≃nd x x'₁ l₂≃r₂ l'₁≃r'₁ r₂≃l'₁) acc-xl₂r₂) (≃nd x x'₁ l₂≃r₂ l'₁≃r'₁ r₂≃l'₁)
             in l⋘ x₂ x' x₁l₁r₁⋘push-xl₂r₂ l'≃r' push-xl₂r₂≃x'₁l'₁r'₁
  ... | inj₂ x₁≤x | inj₁ x≤x₂ | _ rewrite lemma-≡-height right x x₁ l₁ r₁ =
             let acc-xl₁r₁ = rs (node right x l₁ r₁) (lemma-≺-left left x (node right x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  push-xl₁r₁⋘x₂l₂r₂ = lemma-push-r⋘ x x₂ l₁⋙r₁ l₂≃r₂ l₁⋗l₂ acc-xl₁r₁
             in l⋘ x₁ x' push-xl₁r₁⋘x₂l₂r₂ l'≃r' (≃nd x₂ x'₁ l₂≃r₂ l'₁≃r'₁ r₂≃l'₁)
  ... | inj₂ x₁≤x | inj₂ x₂≤x | inj₁ x₁≤x₂ rewrite lemma-≡-height right x x₁ l₁ r₁ =
             let acc-xl₁r₁ = rs (node right x l₁ r₁) (lemma-≺-left left x (node right x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  push-xl₁r₁⋘x₂l₂r₂ = lemma-push-r⋘ x x₂ l₁⋙r₁ l₂≃r₂ l₁⋗l₂ acc-xl₁r₁
             in l⋘ x₁ x' push-xl₁r₁⋘x₂l₂r₂ l'≃r' (≃nd x₂ x'₁ l₂≃r₂ l'₁≃r'₁ r₂≃l'₁)
  ... | inj₂ x₁≤x | inj₂ x₂≤x | inj₂ x₂≤x₁ rewrite lemma-≡-height perfect x x₂ l₂ r₂ =
             let acc-xl₂r₂ = rs (node perfect x l₂ r₂) (lemma-≺-right left x (node right x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  x₁l₁r₁⋘push-xl₂r₂ = lemma-⋘-push (r⋘ x₁ x l₁⋙r₁ l₂≃r₂ l₁⋗l₂) acc-xl₂r₂ ;
                  push-xl₂r₂≃x'₁l'₁r'₁ = trans≃ (lemma-push-≃ (≃nd x x'₁ l₂≃r₂ l'₁≃r'₁ r₂≃l'₁) acc-xl₂r₂) (≃nd x x'₁ l₂≃r₂ l'₁≃r'₁ r₂≃l'₁)
             in l⋘ x₂ x' x₁l₁r₁⋘push-xl₂r₂ l'≃r' push-xl₂r₂≃x'₁l'₁r'₁

  lemma-push-r⋘ : {l r l' r' : PLRTree}(x x' : A) → l ⋙ r → l' ≃ r' → l ⋗ l' → (acc : Acc _≺_ (node right x l r)) → push (node right x l r) acc ⋘ node perfect x' l' r'
  lemma-push-r⋘ x x' (⋙p (⋗lf x₁)) ≃lf (⋗lf .x₁) (acc rs)
      with tot≤ x x₁
  ... | inj₁ x≤x₁ = x⋘ x x₁ x'
  ... | inj₂ x₁≤x = x⋘ x₁ x x'
  lemma-push-r⋘  _ _ (⋙p (⋗lf x₁)) _ (⋗nd .x₁ _ _ _ ()) _
  lemma-push-r⋘ _ _ (⋙p (⋗nd x₁ _ _ _ ())) ≃lf (⋗lf .x₁) _
  lemma-push-r⋘ x x' (⋙p (⋗nd {l₁} {r₁} {l₂} {r₂} x₁ x₂ l₁≃r₁ l₂≃r₂ l₁⋗l₂)) l'≃r' (⋗nd .x₁ x'₁ _ l'₁≃r'₁ l₁⋗l'₁) (acc rs)
      with tot≤ x x₁ | tot≤ x x₂ | tot≤ x₁ x₂
  ... | inj₁ x≤x₁ | inj₁ x≤x₂ | _ = r⋘ x x' (⋙p (⋗nd x₁ x₂ l₁≃r₁ l₂≃r₂ l₁⋗l₂)) l'≃r' (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)
  ... | inj₁ x≤x₁ | inj₂ x₂≤x | _ rewrite lemma-≡-height perfect x x₂ l₂ r₂ =
             let acc-xl₂r₂ = rs (node perfect x l₂ r₂) (lemma-≺-right perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  x₁l₁r₁⋗push-xl₂r₂ = lemma-⋗-push (⋗nd x₁ x l₁≃r₁ l₂≃r₂ l₁⋗l₂) acc-xl₂r₂
             in r⋘ x₂ x' (⋙p x₁l₁r₁⋗push-xl₂r₂) l'≃r' (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)
  ... | inj₂ x₁≤x | inj₁ x≤x₂ | _ rewrite lemma-≡-height perfect x x₁ l₁ r₁ =
             let acc-xl₁r₁ = rs (node perfect x l₁ r₁) (lemma-≺-left perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  push-xl₁r₁⋗x₂l₂r₂ = lemma-push-⋗ (⋗nd x x₂ l₁≃r₁ l₂≃r₂ l₁⋗l₂) acc-xl₁r₁ ;
                  push-xl₁r₁⋗x'₁l'₁r'₁ = lemma-push-⋗ (⋗nd x x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁) acc-xl₁r₁
             in r⋘ x₁ x' (⋙p push-xl₁r₁⋗x₂l₂r₂) l'≃r' push-xl₁r₁⋗x'₁l'₁r'₁
  ... | inj₂ x₁≤x | inj₂ x₂≤x | inj₁ x₁≤x₂ rewrite lemma-≡-height perfect x x₁ l₁ r₁ =
             let acc-xl₁r₁ = rs (node perfect x l₁ r₁) (lemma-≺-left perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  push-xl₁r₁⋗x₂l₂r₂ = lemma-push-⋗ (⋗nd x x₂ l₁≃r₁ l₂≃r₂ l₁⋗l₂) acc-xl₁r₁ ;
                  push-xl₁r₁⋗x'₁l'₁r'₁ = lemma-push-⋗ (⋗nd x x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁) acc-xl₁r₁
             in r⋘ x₁ x' (⋙p push-xl₁r₁⋗x₂l₂r₂) l'≃r' push-xl₁r₁⋗x'₁l'₁r'₁
  ... | inj₂ x₁≤x | inj₂ x₂≤x | inj₂ x₂≤x₁ rewrite lemma-≡-height perfect x x₂ l₂ r₂ =
             let acc-xl₂r₂ = rs (node perfect x l₂ r₂) (lemma-≺-right perfect x (node perfect x₁ l₁ r₁) (node perfect x₂ l₂ r₂)) ;
                  x₁l₁r₁⋗push-xl₂r₂ = lemma-⋗-push (⋗nd x₁ x l₁≃r₁ l₂≃r₂ l₁⋗l₂) acc-xl₂r₂
             in r⋘ x₂ x' (⋙p x₁l₁r₁⋗push-xl₂r₂) l'≃r' (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)
  lemma-push-r⋘  _ _ (⋙l x₁ _ _ _ ()) _ (⋗lf .x₁) _
  lemma-push-r⋘ x x' (⋙l {l₁} {r₁} {l₂} {r₂} x₁ x₂ l₁≃r₁ l₂⋘r₂ l₁⋗r₂) l'≃r' (⋗nd .x₁ x'₁ _ l'₁≃r'₁ l₁⋗l'₁) (acc rs)
      with tot≤ x x₁ | tot≤ x x₂ | tot≤ x₁ x₂
  ... | inj₁ x≤x₁ | inj₁ x≤x₂ | _ = r⋘ x x' (⋙l x₁ x₂ l₁≃r₁ l₂⋘r₂ l₁⋗r₂) l'≃r' (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)
  ... | inj₁ x≤x₁ | inj₂ x₂≤x | _ rewrite lemma-≡-height left x x₂ l₂ r₂ =
             let acc-xl₂r₂ = rs (node left x l₂ r₂) (lemma-≺-right right x (node perfect x₁ l₁ r₁) (node left x₂ l₂ r₂)) ;
                  x₁l₁r₁⋙push-xl₂r₂ = lemma-⋙l-push x₁ x l₁≃r₁ l₂⋘r₂ l₁⋗r₂ acc-xl₂r₂
             in r⋘ x₂ x' x₁l₁r₁⋙push-xl₂r₂ l'≃r' (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)
  ... | inj₂ x₁≤x | inj₁ x≤x₂ | _ rewrite lemma-≡-height perfect x x₁ l₁ r₁ =
             let acc-xl₁r₁ = rs (node perfect x l₁ r₁) (lemma-≺-left right x (node perfect x₁ l₁ r₁) (node left x₂ l₂ r₂)) ;
                  push-xl₁r₁⋙x₂l₂r₂ = lemma-push-⋙ (⋙l x x₂ l₁≃r₁ l₂⋘r₂ l₁⋗r₂) acc-xl₁r₁ ;
                  push-xl₁r₁⋗x'₁l'₁r'₁ = lemma-push-⋗ (⋗nd x x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁) acc-xl₁r₁
             in r⋘ x₁ x' push-xl₁r₁⋙x₂l₂r₂ l'≃r' push-xl₁r₁⋗x'₁l'₁r'₁
  ... | inj₂ x₁≤x | inj₂ x₂≤x | inj₁ x₁≤x₂ rewrite lemma-≡-height perfect x x₁ l₁ r₁ =
             let acc-xl₁r₁ = rs (node perfect x l₁ r₁) (lemma-≺-left right x (node perfect x₁ l₁ r₁) (node left x₂ l₂ r₂)) ;
                  push-xl₁r₁⋙x₂l₂r₂ = lemma-push-⋙ (⋙l x x₂ l₁≃r₁ l₂⋘r₂ l₁⋗r₂) acc-xl₁r₁ ;
                  push-xl₁r₁⋗x'₁l'₁r'₁ = lemma-push-⋗ (⋗nd x x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁) acc-xl₁r₁
             in r⋘ x₁ x' push-xl₁r₁⋙x₂l₂r₂ l'≃r' push-xl₁r₁⋗x'₁l'₁r'₁
  ... | inj₂ x₁≤x | inj₂ x₂≤x | inj₂ x₂≤x₁ rewrite lemma-≡-height left x x₂ l₂ r₂ =
             let acc-xl₂r₂ = rs (node left x l₂ r₂) (lemma-≺-right right x (node perfect x₁ l₁ r₁) (node left x₂ l₂ r₂)) ;
                  x₁l₁r₁⋙push-xl₂r₂ = lemma-⋙l-push x₁ x l₁≃r₁ l₂⋘r₂ l₁⋗r₂ acc-xl₂r₂
             in r⋘ x₂ x' x₁l₁r₁⋙push-xl₂r₂ l'≃r' (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)
  lemma-push-r⋘ _ _ (⋙r x₁ _ ≃lf (⋙p ()) ≃lf) ≃lf (⋗lf .x₁) _
  lemma-push-r⋘ _ _ (⋙r x₁ x₂ ≃lf (⋙l _ _ _ _ _) ()) ≃lf (⋗lf .x₁) _
  lemma-push-r⋘ _ _ (⋙r x₁ x₂ ≃lf (⋙r _ _ _ _ _) ()) ≃lf (⋗lf .x₁) _
  lemma-push-r⋘ x x' (⋙r {l₁} {r₁} {l₂} {r₂} x₁ x₂ l₁≃r₁ l₂⋙r₂ l₁≃l₂) l'≃r' (⋗nd .x₁ x'₁ _ l'₁≃r'₁ l₁⋗l'₁) (acc rs)
      with tot≤ x x₁ | tot≤ x x₂ | tot≤ x₁ x₂
  ... | inj₁ x≤x₁ | inj₁ x≤x₂ | _ = r⋘ x x' (⋙r x₁ x₂ l₁≃r₁ l₂⋙r₂ l₁≃l₂) l'≃r' (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)
  ... | inj₁ x≤x₁ | inj₂ x₂≤x | _ rewrite lemma-≡-height right x x₂ l₂ r₂ =
             let acc-xl₂r₂ = rs (node right x l₂ r₂) (lemma-≺-right right x (node perfect x₁ l₁ r₁) (node right x₂ l₂ r₂)) ;
                  x₁l₁r₁⋙push-xl₂r₂ = lemma-⋙r-push x₁ x l₁≃r₁ l₂⋙r₂ l₁≃l₂ acc-xl₂r₂
             in r⋘ x₂ x' x₁l₁r₁⋙push-xl₂r₂ l'≃r' (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)
  ... | inj₂ x₁≤x | inj₁ x≤x₂ | _ rewrite lemma-≡-height perfect x x₁ l₁ r₁ =
             let acc-xl₁r₁ = rs (node perfect x l₁ r₁) (lemma-≺-left right x (node perfect x₁ l₁ r₁) (node right x₂ l₂ r₂)) ;
                  push-xl₁r₁⋙x₂l₂r₂ = lemma-push-⋙ (⋙r x x₂ l₁≃r₁ l₂⋙r₂ l₁≃l₂) acc-xl₁r₁ ;
                  push-xl₁r₁⋗x'₁l'₁r'₁ = lemma-push-⋗ (⋗nd x x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁) acc-xl₁r₁
             in r⋘ x₁ x' push-xl₁r₁⋙x₂l₂r₂ l'≃r' push-xl₁r₁⋗x'₁l'₁r'₁
  ... | inj₂ x₁≤x | inj₂ x₂≤x | inj₁ x₁≤x₂ rewrite lemma-≡-height perfect x x₁ l₁ r₁ =
             let acc-xl₁r₁ = rs (node perfect x l₁ r₁) (lemma-≺-left right x (node perfect x₁ l₁ r₁) (node right x₂ l₂ r₂)) ;
                  push-xl₁r₁⋙x₂l₂r₂ = lemma-push-⋙ (⋙r x x₂ l₁≃r₁ l₂⋙r₂ l₁≃l₂) acc-xl₁r₁ ;
                  push-xl₁r₁⋗x'₁l'₁r'₁ = lemma-push-⋗ (⋗nd x x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁) acc-xl₁r₁
             in r⋘ x₁ x' push-xl₁r₁⋙x₂l₂r₂ l'≃r' push-xl₁r₁⋗x'₁l'₁r'₁
  ... | inj₂ x₁≤x | inj₂ x₂≤x | inj₂ x₂≤x₁ rewrite lemma-≡-height right x x₂ l₂ r₂ =
             let acc-xl₂r₂ = rs (node right x l₂ r₂) (lemma-≺-right right x (node perfect x₁ l₁ r₁) (node right x₂ l₂ r₂)) ;
                  x₁l₁r₁⋙push-xl₂r₂ = lemma-⋙r-push x₁ x l₁≃r₁ l₂⋙r₂ l₁≃l₂ acc-xl₂r₂
             in r⋘ x₂ x' x₁l₁r₁⋙push-xl₂r₂ l'≃r' (⋗nd x₁ x'₁ l₁≃r₁ l'₁≃r'₁ l₁⋗l'₁)

  lemma-⋙l-push : {l r l' r' : PLRTree}(x x' : A) → l ≃ r → l' ⋘ r' → l ⋗ r' → (acc : Acc _≺_ (node left x' l' r')) → node perfect x l r ⋙ push (node left x' l' r') acc
  lemma-⋙l-push x x' l≃r (x⋘ x'₁ x'₂ x'₃) (⋗nd x₁ .x'₃ x₂≃x₃ ≃lf (⋗lf x₂)) (acc rs)
      with tot≤ x' x'₁ | tot≤ x' x'₃ | tot≤ x'₁ x'₃
  ... | inj₁ x'≤x'₁ | inj₁ x'≤x'₃ | _ = ⋙l x x' l≃r (x⋘ x'₁ x'₂ x'₃) (⋗nd x₁ x'₃ x₂≃x₃ ≃lf (⋗lf x₂))
  ... | inj₁ x'≤x'₁ | inj₂ x'₃≤x' | _ = ⋙l x x'₃ l≃r (x⋘ x'₁ x'₂ x') (⋗nd x₁ x' x₂≃x₃ ≃lf (⋗lf x₂))
  ... | inj₂ x'₁≤x' | inj₁ x'≤x'₃ | _
      with tot≤ x' x'₂
  ... | inj₁ x'≤x'₂ = ⋙l x x'₁ l≃r (x⋘ x' x'₂ x'₃) (⋗nd x₁ x'₃ x₂≃x₃ ≃lf (⋗lf x₂))
  ... | inj₂ x'₂≤x' = ⋙l x x'₁ l≃r (x⋘ x'₂ x' x'₃) (⋗nd x₁ x'₃ x₂≃x₃ ≃lf (⋗lf x₂))
  lemma-⋙l-push x x' l≃r (x⋘ x'₁ x'₂ x'₃) (⋗nd x₁ .x'₃ x₂≃x₃ ≃lf (⋗lf x₂)) (acc rs) | inj₂ x'₁≤x' | inj₂ x'₃≤x' | inj₁ x'₁≤x'₃
      with tot≤ x' x'₂
  ... | inj₁ x'≤x'₂ = ⋙l x x'₁ l≃r (x⋘ x' x'₂ x'₃) (⋗nd x₁ x'₃ x₂≃x₃ ≃lf (⋗lf x₂))
  ... | inj₂ x'₂≤x' = ⋙l x x'₁ l≃r (x⋘ x'₂ x' x'₃) (⋗nd x₁ x'₃ x₂≃x₃ ≃lf (⋗lf x₂))
  lemma-⋙l-push x x' l≃r (x⋘ x'₁ x'₂ x'₃) (⋗nd x₁ .x'₃ x₂≃x₃ ≃lf (⋗lf x₂)) (acc rs) | inj₂ x'₁≤x' | inj₂ x'₃≤x' | inj₂ x'₃≤x'₁ =  ⋙l x x'₃ l≃r (x⋘ x'₁ x'₂ x') (⋗nd x₁ x' x₂≃x₃ ≃lf (⋗lf x₂))
  lemma-⋙l-push x x' l≃r (l⋘ {l'₁} {r'₁} {l'₂} {r'₂} x'₁ x'₂ l'₁⋘r'₁ l'₂≃r'₂ r'₁≃l'₂) (⋗nd x₁ .x'₂ l₁≃r₁ _ l₁⋗l'₂) (acc rs)
      with tot≤ x' x'₁ | tot≤ x' x'₂ | tot≤ x'₁ x'₂
  ... | inj₁ x'≤x'₁ | inj₁ x'≤x'₂ | _ = ⋙l x x' l≃r (l⋘ x'₁ x'₂ l'₁⋘r'₁ l'₂≃r'₂ r'₁≃l'₂) (⋗nd x₁ x'₂ l₁≃r₁ l'₂≃r'₂ l₁⋗l'₂)
  ... | inj₁ x'≤x'₁ | inj₂ x'₂≤x' | _ rewrite lemma-≡-height perfect x' x'₂ l'₂ r'₂  =
             let acc-x'l'₂r'₂ = rs (node perfect x' l'₂ r'₂) (lemma-≺-right left x' (node left x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                  x'₁l'₁r'₁⋘push-x'l'₂r'₂ = lemma-⋘-push (l⋘ x'₁ x' l'₁⋘r'₁ l'₂≃r'₂ r'₁≃l'₂) acc-x'l'₂r'₂ ;
                  x₁l₁r₁⋗push-x'l'₂r'₂ = lemma-⋗-push (⋗nd x₁ x' l₁≃r₁ l'₂≃r'₂ l₁⋗l'₂) acc-x'l'₂r'₂
             in ⋙l x x'₂ l≃r x'₁l'₁r'₁⋘push-x'l'₂r'₂ x₁l₁r₁⋗push-x'l'₂r'₂
  ... | inj₂ x'₁≤x' | inj₁ x'≤x'₂ | _ rewrite lemma-≡-height left x' x'₁ l'₁ r'₁ =
             let acc-x'l'₁r'₁ = rs (node left x' l'₁ r'₁) (lemma-≺-left left x' (node left x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                  push-x'l'₁r'₁⋘x'₂l'₂r'₂ = lemma-push-l⋘ x' x'₂ l'₁⋘r'₁ l'₂≃r'₂ r'₁≃l'₂ acc-x'l'₁r'₁
             in ⋙l x x'₁ l≃r push-x'l'₁r'₁⋘x'₂l'₂r'₂ (⋗nd x₁ x'₂ l₁≃r₁ l'₂≃r'₂ l₁⋗l'₂)
  ... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₁ x'₁≤x'₂ rewrite lemma-≡-height left x' x'₁ l'₁ r'₁ =
             let acc-x'l'₁r'₁ = rs (node left x' l'₁ r'₁) (lemma-≺-left left x' (node left x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                  push-x'l'₁r'₁⋘x'₂l'₂r'₂ = lemma-push-l⋘ x' x'₂ l'₁⋘r'₁ l'₂≃r'₂ r'₁≃l'₂ acc-x'l'₁r'₁
             in ⋙l x x'₁ l≃r push-x'l'₁r'₁⋘x'₂l'₂r'₂ (⋗nd x₁ x'₂ l₁≃r₁ l'₂≃r'₂ l₁⋗l'₂)
  ... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₂ x'₂≤x'₁ rewrite lemma-≡-height perfect x' x'₂ l'₂ r'₂ =
             let acc-x'l'₂r'₂ = rs (node perfect x' l'₂ r'₂) (lemma-≺-right left x' (node left x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                  x'₁l'₁r'₁⋘push-x'l'₂r'₂ = lemma-⋘-push (l⋘ x'₁ x' l'₁⋘r'₁ l'₂≃r'₂ r'₁≃l'₂) acc-x'l'₂r'₂ ;
                  x₁l₁r₁⋗push-x'l'₂r'₂ = lemma-⋗-push (⋗nd x₁ x' l₁≃r₁ l'₂≃r'₂ l₁⋗l'₂) acc-x'l'₂r'₂
             in ⋙l x x'₂ l≃r x'₁l'₁r'₁⋘push-x'l'₂r'₂ x₁l₁r₁⋗push-x'l'₂r'₂
  lemma-⋙l-push x x' l≃r (r⋘ {l'₁} {r'₁} {l'₂} {r'₂} x'₁ x'₂ l'₁⋙r'₁ l'₂≃r'₂ l'₁⋗l'₂) (⋗nd x₁ .x'₂ l₁≃r₁ _ l₁⋗l'₂) (acc rs)
      with tot≤ x' x'₁ | tot≤ x' x'₂ | tot≤ x'₁ x'₂
  ... | inj₁ x'≤x'₁ | inj₁ x'≤x'₂ | _ = ⋙l x x' l≃r (r⋘ x'₁ x'₂ l'₁⋙r'₁ l'₂≃r'₂ l'₁⋗l'₂) (⋗nd x₁ x'₂ l₁≃r₁ l'₂≃r'₂ l₁⋗l'₂)
  ... | inj₁ x'≤x'₁ | inj₂ x'₂≤x' | _ rewrite lemma-≡-height perfect x' x'₂ l'₂ r'₂  =
             let acc-x'l'₂r'₂ = rs (node perfect x' l'₂ r'₂) (lemma-≺-right left x' (node right x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                  x'₁l'₁r'₁⋘push-x'l'₂r'₂ = lemma-⋘-push (r⋘ x'₁ x' l'₁⋙r'₁ l'₂≃r'₂ l'₁⋗l'₂) acc-x'l'₂r'₂ ;
                  x₁l₁r₁⋗push-x'l'₂r'₂ = lemma-⋗-push (⋗nd x₁ x' l₁≃r₁ l'₂≃r'₂ l₁⋗l'₂) acc-x'l'₂r'₂
             in ⋙l x x'₂ l≃r x'₁l'₁r'₁⋘push-x'l'₂r'₂ x₁l₁r₁⋗push-x'l'₂r'₂
  ... | inj₂ x'₁≤x' | inj₁ x'≤x'₂ | _ rewrite lemma-≡-height right x' x'₁ l'₁ r'₁ =
             let acc-x'l'₁r'₁ = rs (node right x' l'₁ r'₁) (lemma-≺-left left x' (node right x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                  push-x'l'₁r'₁⋘x'₂l'₂r'₂ = lemma-push-r⋘ x' x'₂ l'₁⋙r'₁ l'₂≃r'₂ l'₁⋗l'₂ acc-x'l'₁r'₁
             in ⋙l x x'₁ l≃r push-x'l'₁r'₁⋘x'₂l'₂r'₂ (⋗nd x₁ x'₂ l₁≃r₁ l'₂≃r'₂ l₁⋗l'₂)
  ... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₁ x'₁≤x'₂ rewrite lemma-≡-height right x' x'₁ l'₁ r'₁ =
             let acc-x'l'₁r'₁ = rs (node right x' l'₁ r'₁) (lemma-≺-left left x' (node right x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                  push-x'l'₁r'₁⋘x'₂l'₂r'₂ = lemma-push-r⋘ x' x'₂ l'₁⋙r'₁ l'₂≃r'₂ l'₁⋗l'₂ acc-x'l'₁r'₁
             in ⋙l x x'₁ l≃r push-x'l'₁r'₁⋘x'₂l'₂r'₂ (⋗nd x₁ x'₂ l₁≃r₁ l'₂≃r'₂ l₁⋗l'₂)
  ... | inj₂ x'₁≤x' | inj₂ x'₂≤x' | inj₂ x'₂≤x'₁ rewrite lemma-≡-height perfect x' x'₂ l'₂ r'₂ =
             let acc-x'l'₂r'₂ = rs (node perfect x' l'₂ r'₂) (lemma-≺-right left x' (node right x'₁ l'₁ r'₁) (node perfect x'₂ l'₂ r'₂)) ;
                  x'₁l'₁r'₁⋘push-x'l'₂r'₂ = lemma-⋘-push (r⋘ x'₁ x' l'₁⋙r'₁ l'₂≃r'₂ l'₁⋗l'₂) acc-x'l'₂r'₂ ;
                  x₁l₁r₁⋗push-x'l'₂r'₂ = lemma-⋗-push (⋗nd x₁ x' l₁≃r₁ l'₂≃r'₂ l₁⋗l'₂) acc-x'l'₂r'₂
             in ⋙l x x'₂ l≃r x'₁l'₁r'₁⋘push-x'l'₂r'₂ x₁l₁r₁⋗push-x'l'₂r'₂

lemma-⋙-push : {t t' : PLRTree} → t ⋙ t' → (acc : Acc _≺_ t') → t ⋙ push t' acc
lemma-⋙-push (⋙p l⋗r) (acc rs) = ⋙p (lemma-⋗-push l⋗r (acc rs))
lemma-⋙-push (⋙l x x' l≃r l'⋘r' l⋗r') (acc rs) = lemma-⋙l-push x x' l≃r l'⋘r' l⋗r' (acc rs)
lemma-⋙-push (⋙r x x' l≃r l'⋙r' l≃l') (acc rs) = lemma-⋙r-push x x' l≃r l'⋙r' l≃l' (acc rs)

lemma-push-⋘ : {t t' : PLRTree} → t ⋘ t' → (acc : Acc _≺_ t) → push t acc ⋘ t'
lemma-push-⋘ (x⋘ x y z) _
    with tot≤ x y
... | inj₁ x≤y = x⋘ x y z
... | inj₂ y≤x = x⋘ y x z
lemma-push-⋘ (l⋘ x x' l⋘r l'≃r' r≃l') (acc rs) = lemma-push-l⋘ x x' l⋘r l'≃r' r≃l' (acc rs)
lemma-push-⋘ (r⋘ x x' l⋙r l'≃r' l⋗l') (acc rs) = lemma-push-r⋘ x x' l⋙r l'≃r' l⋗l' (acc rs)

lemma-push-complete-≃ : {l r : PLRTree}(x : A) → Complete l → Complete r → l ≃ r → (acc : Acc _≺_ (node perfect x l r)) → Complete (push (node perfect x l r) acc)
lemma-push-complete-≃ {l} {r} x cl cr l≃r (acc rs)
    with l | r | l≃r | cl | cr
... | leaf | leaf | ≃lf | _ | _ = perfect x leaf leaf ≃lf
... | node perfect x' l' r' | node perfect x'' l'' r'' | ≃nd .x' .x'' l'≃r' l''≃r'' l'≃l'' | perfect .x' cl' cr' _ | perfect .x'' cl'' cr'' _
    with tot≤ x x' | tot≤ x x'' | tot≤ x' x''
... | inj₁ x≤x' | inj₁ x≤x'' | _ = perfect x (perfect x' cl' cr' l'≃r') (perfect x'' cl'' cr'' l''≃r'') (≃nd x' x'' l'≃r' l''≃r'' l'≃l'')
... | inj₁ x≤x' | inj₂ x''≤x | _ rewrite lemma-≡-height perfect x x'' l'' r'' =
           let acc-xl''r'' = rs (node perfect x l'' r'') (lemma-≺-right perfect x (node perfect x' l' r') (node perfect x'' l'' r'')) ;
                xl''r''≃push-xl''r'' = lemma-≃-push (sym≃ (≃nd x x l'≃r' l''≃r'' l'≃l'')) acc-xl''r'' ;
                x'l'r'≃push-xl''r'' = trans≃ (≃nd x' x l'≃r' l''≃r'' l'≃l'') xl''r''≃push-xl''r''
           in perfect x'' (perfect x' cl' cr' l'≃r') (lemma-push-complete-≃ x cl'' cr'' l''≃r'' acc-xl''r'') x'l'r'≃push-xl''r''
... | inj₂ x'≤x | inj₁ x≤x'' | _ rewrite lemma-≡-height perfect x x' l' r' =
           let acc-xl'r' = rs (node perfect x l' r') (lemma-≺-left perfect x (node perfect x' l' r') (node perfect x'' l'' r'')) ;
                push-xl'r'≃xl'r' = lemma-push-≃ (≃nd x x l'≃r' l''≃r'' l'≃l'') acc-xl'r' ;
                push-xl'r'≃x''l''r'' = trans≃ push-xl'r'≃xl'r' (≃nd x x'' l'≃r' l''≃r'' l'≃l'')
           in perfect x' (lemma-push-complete-≃ x cl' cr' l'≃r' acc-xl'r') (perfect x'' cl'' cr'' l''≃r'') push-xl'r'≃x''l''r''
... | inj₂ x'≤x | inj₂ x''≤x | inj₁ x'≤x'' rewrite lemma-≡-height perfect x x' l' r' =
           let acc-xl'r' = rs (node perfect x l' r') (lemma-≺-left perfect x (node perfect x' l' r') (node perfect x'' l'' r'')) ;
                push-xl'r'≃xl'r' = lemma-push-≃ (≃nd x x l'≃r' l''≃r'' l'≃l'') acc-xl'r' ;
                push-xl'r'≃x''l''r'' = trans≃ push-xl'r'≃xl'r' (≃nd x x'' l'≃r' l''≃r'' l'≃l'')
           in perfect x' (lemma-push-complete-≃ x cl' cr' l'≃r' acc-xl'r') (perfect x'' cl'' cr'' l''≃r'') push-xl'r'≃x''l''r''
... | inj₂ x'≤x | inj₂ x''≤x | inj₂ x''≤x' rewrite lemma-≡-height perfect x x'' l'' r'' =
           let acc-xl''r'' = rs (node perfect x l'' r'') (lemma-≺-right perfect x (node perfect x' l' r') (node perfect x'' l'' r'')) ;
                xl''r''≃push-xl''r'' = lemma-≃-push (sym≃ (≃nd x x l'≃r' l''≃r'' l'≃l'')) acc-xl''r'' ;
                x'l'r'≃push-xl''r'' = trans≃ (≃nd x' x l'≃r' l''≃r'' l'≃l'') xl''r''≃push-xl''r''
           in perfect x'' (perfect x' cl' cr' l'≃r') (lemma-push-complete-≃ x cl'' cr'' l''≃r'' acc-xl''r'') x'l'r'≃push-xl''r''

lemma-push-complete-⋗ : {l r : PLRTree}(x : A) → Complete l → Complete r → l ⋗ r → (acc : Acc _≺_ (node right x l r)) → Complete (push (node right x l r) acc)
lemma-push-complete-⋗ {l} {r} x cl cr l⋗r (acc rs)
    with l | r | l⋗r | cl | cr
... | leaf | _ | () | _ | _
... | node perfect x' leaf leaf | leaf | ⋗lf .x' | perfect .x' leaf leaf ≃lf | leaf
    with tot≤ x x'
... | inj₁ x≤x' = right x (perfect x' leaf leaf ≃lf) leaf (⋙p (⋗lf x'))
... | inj₂ x'≤x = right x' (perfect x leaf leaf ≃lf) leaf (⋙p (⋗lf x))
lemma-push-complete-⋗ x cl cr l⋗r (acc rs) | node perfect x' l' r' | node perfect x'' l'' r'' | ⋗nd .x' .x'' l'≃r' l''≃r'' l'⋗l'' | perfect .x' cl' cr' _ | perfect .x'' cl'' cr'' _
    with tot≤ x x' | tot≤ x x'' | tot≤ x' x''
... | inj₁ x≤x' | inj₁ x≤x'' | _ = right x (perfect x' cl' cr' l'≃r') (perfect x'' cl'' cr'' l''≃r'') (⋙p (⋗nd x' x'' l'≃r' l''≃r'' l'⋗l''))
... | inj₁ x≤x' | inj₂ x''≤x | _ rewrite lemma-≡-height perfect x x'' l'' r'' =
           let acc-xl''r'' = rs (node perfect x l'' r'') (lemma-≺-right right x (node perfect x' l' r') (node perfect x'' l'' r'')) ;
                x'l'r'⋗push-xl''r'' = lemma-⋗-push (⋗nd x' x l'≃r' l''≃r'' l'⋗l'') acc-xl''r''
           in right x'' (perfect x' cl' cr' l'≃r') (lemma-push-complete-≃ x cl'' cr'' l''≃r'' acc-xl''r'') (⋙p x'l'r'⋗push-xl''r'')
... | inj₂ x'≤x | inj₁ x≤x'' | _ rewrite lemma-≡-height perfect x x' l' r' =
           let acc-xl'r' = rs (node perfect x l' r') (lemma-≺-left right x (node perfect x' l' r') (node perfect x'' l'' r'')) ;
                push-xl'r'⋗x''l''r'' = lemma-push-⋗ (⋗nd x x'' l'≃r' l''≃r'' l'⋗l'') acc-xl'r'
           in right x' (lemma-push-complete-≃ x cl' cr' l'≃r' acc-xl'r') (perfect x'' cl'' cr'' l''≃r'') (⋙p push-xl'r'⋗x''l''r'')
... | inj₂ x'≤x | inj₂ x''≤x | inj₁ x'≤x'' rewrite lemma-≡-height perfect x x' l' r' =
           let acc-xl'r' = rs (node perfect x l' r') (lemma-≺-left right x (node perfect x' l' r') (node perfect x'' l'' r'')) ;
                push-xl'r'⋗x''l''r'' = lemma-push-⋗ (⋗nd x x'' l'≃r' l''≃r'' l'⋗l'') acc-xl'r'
           in right x' (lemma-push-complete-≃ x cl' cr' l'≃r' acc-xl'r') (perfect x'' cl'' cr'' l''≃r'') (⋙p push-xl'r'⋗x''l''r'')
... | inj₂ x'≤x | inj₂ x''≤x | inj₂ x''≤x' rewrite lemma-≡-height perfect x x'' l'' r'' =
           let acc-xl''r'' = rs (node perfect x l'' r'') (lemma-≺-right right x (node perfect x' l' r') (node perfect x'' l'' r'')) ;
                x'l'r'⋗push-xl''r'' = lemma-⋗-push (⋗nd x' x l'≃r' l''≃r'' l'⋗l'') acc-xl''r''
           in right x'' (perfect x' cl' cr' l'≃r') (lemma-push-complete-≃ x cl'' cr'' l''≃r'' acc-xl''r'') (⋙p x'l'r'⋗push-xl''r'')

mutual
  lemma-push-complete-⋙ : {l r : PLRTree}(x : A) → Complete l → Complete r → l ⋙ r → (acc : Acc _≺_ (node right x l r)) → Complete (push (node right x l r) acc)
  lemma-push-complete-⋙ {l} {r} x cl cr l⋙r (acc rs)
      with l | r | l⋙r | cl | cr
  ... | leaf | _ | ⋙p () | _ | _
  ... | node perfect x' leaf leaf | leaf | ⋙p (⋗lf .x') | perfect .x' leaf leaf ≃lf | leaf =
             lemma-push-complete-⋗ x (perfect x' leaf leaf ≃lf) leaf (⋗lf x') (acc rs)
  ... | node perfect x' l' r' | node perfect x'' l'' r'' | ⋙p (⋗nd .x' .x'' l'≃r' l''≃r'' l'⋗l'') | perfect .x' cl' cr' _ | perfect .x'' cl'' cr'' _ =
             lemma-push-complete-⋗ x (perfect x' cl' cr' l'≃r') (perfect x'' cl'' cr'' l''≃r'') (⋗nd x' x'' l'≃r' l''≃r'' l'⋗l'') (acc rs)
  ... | node perfect x' leaf leaf | node left _ _ _ | ⋙p () | _ | _
  ... | node perfect x' leaf leaf | node right _ _ _ | ⋙p () | _ | _
  ... | node perfect x' l' r' | node left x'' l'' r'' | ⋙l .x' .x'' l'≃r' l''⋘r'' l'⋗r'' | perfect .x' cl' cr' _ | left .x'' cl'' cr'' _
      with tot≤ x x' | tot≤ x x'' | tot≤ x' x''
  ... | inj₁ x≤x' | inj₁ x≤x'' | _ = right x (perfect x' cl' cr' l'≃r') (left x'' cl'' cr'' l''⋘r'') (⋙l x' x'' l'≃r' l''⋘r'' l'⋗r'')
  ... | inj₁ x≤x' | inj₂ x''≤x | _ rewrite lemma-≡-height left x x'' l'' r'' =
             let acc-xl''r'' = rs (node left x l'' r'') (lemma-≺-right right x (node perfect x' l' r') (node left x'' l'' r'')) ;
                  x'l'r'⋙push-xl''r'' = lemma-⋙-push (⋙l x' x l'≃r' l''⋘r'' l'⋗r'') acc-xl''r''
             in right x'' (perfect x' cl' cr' l'≃r') (lemma-push-complete-⋘ x cl'' cr'' l''⋘r'' acc-xl''r'') x'l'r'⋙push-xl''r''
  ... | inj₂ x'≤x | inj₁ x≤x'' | _ rewrite lemma-≡-height perfect x x' l' r' =
             let acc-xl'r' = rs (node perfect x l' r') (lemma-≺-left right x (node perfect x' l' r') (node left x'' l'' r'')) ;
                  push-xl'r'⋙x''l''r'' = lemma-push-⋙ (⋙l x x'' l'≃r' l''⋘r'' l'⋗r'') acc-xl'r'
             in right x' (lemma-push-complete-≃ x cl' cr' l'≃r' acc-xl'r') (left x'' cl'' cr'' l''⋘r'') push-xl'r'⋙x''l''r''
  ... | inj₂ x'≤x | inj₂ x''≤x | inj₁ x'≤x'' rewrite lemma-≡-height perfect x x' l' r' =
             let acc-xl'r' = rs (node perfect x l' r') (lemma-≺-left right x (node perfect x' l' r') (node left x'' l'' r'')) ;
                  push-xl'r'⋙x''l''r'' = lemma-push-⋙ (⋙l x x'' l'≃r' l''⋘r'' l'⋗r'') acc-xl'r'
             in right x' (lemma-push-complete-≃ x cl' cr' l'≃r' acc-xl'r') (left x'' cl'' cr'' l''⋘r'') push-xl'r'⋙x''l''r''
  ... | inj₂ x'≤x | inj₂ x''≤x | inj₂ x''≤x' rewrite lemma-≡-height left x x'' l'' r'' =
             let acc-xl''r'' = rs (node left x l'' r'') (lemma-≺-right right x (node perfect x' l' r') (node left x'' l'' r'')) ;
                  x'l'r'⋙push-xl''r'' = lemma-⋙-push (⋙l x' x l'≃r' l''⋘r'' l'⋗r'') acc-xl''r''
             in right x'' (perfect x' cl' cr' l'≃r') (lemma-push-complete-⋘ x cl'' cr'' l''⋘r'' acc-xl''r'') x'l'r'⋙push-xl''r''
  lemma-push-complete-⋙ x cl cr l⋙r (acc rs)| node perfect x' l' r' | node right x'' l'' r'' | ⋙r .x' .x'' l'≃r' l''⋙r'' l'≃l'' | perfect .x' cl' cr' _ | right .x'' cl'' cr'' _
      with tot≤ x x' | tot≤ x x'' | tot≤ x' x''
  ... | inj₁ x≤x' | inj₁ x≤x'' | _ = right x (perfect x' cl' cr' l'≃r') (right x'' cl'' cr'' l''⋙r'') (⋙r x' x'' l'≃r' l''⋙r'' l'≃l'')
  ... | inj₁ x≤x' | inj₂ x''≤x | _ rewrite lemma-≡-height right x x'' l'' r'' =
             let acc-xl''r'' = rs (node right x l'' r'') (lemma-≺-right right x (node perfect x' l' r') (node right x'' l'' r'')) ;
                  x'l'r'⋙push-xl''r'' = lemma-⋙-push (⋙r x' x l'≃r' l''⋙r'' l'≃l'') acc-xl''r''
             in right x'' (perfect x' cl' cr' l'≃r') (lemma-push-complete-⋙ x cl'' cr'' l''⋙r'' acc-xl''r'') x'l'r'⋙push-xl''r''
  ... | inj₂ x'≤x | inj₁ x≤x'' | _ rewrite lemma-≡-height perfect x x' l' r' =
             let acc-xl'r' = rs (node perfect x l' r') (lemma-≺-left right x (node perfect x' l' r') (node right x'' l'' r'')) ;
                  push-xl'r'⋙x''l''r'' = lemma-push-⋙ (⋙r x x'' l'≃r' l''⋙r'' l'≃l'') acc-xl'r'
             in right x' (lemma-push-complete-≃ x cl' cr' l'≃r' acc-xl'r') (right x'' cl'' cr'' l''⋙r'') push-xl'r'⋙x''l''r''
  ... | inj₂ x'≤x | inj₂ x''≤x | inj₁ x'≤x'' rewrite lemma-≡-height perfect x x' l' r' =
             let acc-xl'r' = rs (node perfect x l' r') (lemma-≺-left right x (node perfect x' l' r') (node right x'' l'' r'')) ;
                  push-xl'r'⋙x''l''r'' = lemma-push-⋙ (⋙r x x'' l'≃r' l''⋙r'' l'≃l'') acc-xl'r'
             in right x' (lemma-push-complete-≃ x cl' cr' l'≃r' acc-xl'r') (right x'' cl'' cr'' l''⋙r'') push-xl'r'⋙x''l''r''
  ... | inj₂ x'≤x | inj₂ x''≤x | inj₂ x''≤x' rewrite lemma-≡-height right x x'' l'' r'' =
             let acc-xl''r'' = rs (node right x l'' r'') (lemma-≺-right right x (node perfect x' l' r') (node right x'' l'' r'')) ;
                  x'l'r'⋙push-xl''r'' = lemma-⋙-push (⋙r x' x l'≃r' l''⋙r'' l'≃l'') acc-xl''r''
             in right x'' (perfect x' cl' cr' l'≃r') (lemma-push-complete-⋙ x cl'' cr'' l''⋙r'' acc-xl''r'') x'l'r'⋙push-xl''r''
  lemma-push-complete-⋙ x cl cr l⋙r (acc rs) | node left _ _ _ | _ | ⋙p () | _ | _
  lemma-push-complete-⋙ x cl cr l⋙r (acc rs) | node right _ _ _ | _ | ⋙p () | _ | _

  lemma-push-complete-⋘ : {l r : PLRTree}(x : A) → Complete l → Complete r → l ⋘ r → (acc : Acc _≺_ (node left x l r)) → Complete (push (node left x l r) acc)
  lemma-push-complete-⋘ {l} {r} x cl cr l⋘r (acc rs)
      with l | r | l⋘r | cl | cr
  ... | node left x' l' r' | node perfect x'' l'' r'' | l⋘ .x' .x'' l'⋘r' l''≃r'' r'≃l'' | left .x' cl' cr' _ | perfect .x'' cl'' cr'' _
      with tot≤ x x' | tot≤ x x'' | tot≤ x' x''
  ... | inj₁ x≤x' | inj₁ x≤x'' | _ = left x (left x' cl' cr' l'⋘r') (perfect x'' cl'' cr'' l''≃r'') (l⋘ x' x'' l'⋘r' l''≃r'' r'≃l'')
  ... | inj₁ x≤x' | inj₂ x''≤x | _ rewrite lemma-≡-height perfect x x'' l'' r'' =
             let acc-xl''r'' = rs (node perfect x l'' r'') (lemma-≺-right left x (node left x' l' r') (node perfect x'' l'' r'')) ;
                  xl''r''≃push-xl''r'' = lemma-≃-push  (≃nd x x l''≃r'' l''≃r'' (lemma-≃-≃ l''≃r'')) acc-xl''r'' ;
                  x''l''r''≃push-xl''r'' = trans≃ (≃nd x'' x l''≃r'' l''≃r'' (lemma-≃-≃ l''≃r'')) xl''r''≃push-xl''r'' ;
                  x'l'r'⋘push-xl''r'' = lemma-⋘-push (l⋘ x' x l'⋘r' l''≃r'' r'≃l'') acc-xl''r''
             in left x'' (left x' cl' cr' l'⋘r') (lemma-push-complete-≃ x cl'' cr'' l''≃r'' acc-xl''r'') x'l'r'⋘push-xl''r''
  ... | inj₂ x'≤x | inj₁ x≤x'' | _ rewrite lemma-≡-height left x x' l' r' =
             let acc-xl'r' = rs (node left x l' r') (lemma-≺-left left x (node left x' l' r') (node perfect x'' l'' r'')) ;
                  push-xl'r'⋘x''l''r'' = lemma-push-⋘ (l⋘ x x'' l'⋘r' l''≃r'' r'≃l'') acc-xl'r'
             in left x' (lemma-push-complete-⋘ x cl' cr' l'⋘r' acc-xl'r') (perfect x'' cl'' cr'' l''≃r'') push-xl'r'⋘x''l''r''
  ... | inj₂ x'≤x | inj₂ x''≤x | inj₁ x'≤x'' rewrite lemma-≡-height left x x' l' r' =
             let acc-xl'r' = rs (node left x l' r') (lemma-≺-left left x (node left x' l' r') (node perfect x'' l'' r'')) ;
                  push-xl'r'⋘x''l''r'' = lemma-push-⋘ (l⋘ x x'' l'⋘r' l''≃r'' r'≃l'') acc-xl'r'
             in left x' (lemma-push-complete-⋘ x cl' cr' l'⋘r' acc-xl'r') (perfect x'' cl'' cr'' l''≃r'') push-xl'r'⋘x''l''r''
  ... | inj₂ x'≤x | inj₂ x''≤x | inj₂ x''≤x' rewrite lemma-≡-height perfect x x'' l'' r'' =
             let acc-xl''r'' = rs (node perfect x l'' r'') (lemma-≺-right left x (node left x' l' r') (node perfect x'' l'' r'')) ;
                  xl''r''≃push-xl''r'' = lemma-≃-push  (≃nd x x l''≃r'' l''≃r'' (lemma-≃-≃ l''≃r'')) acc-xl''r'' ;
                  x''l''r''≃push-xl''r'' = trans≃ (≃nd x'' x l''≃r'' l''≃r'' (lemma-≃-≃ l''≃r'')) xl''r''≃push-xl''r'' ;
                  x'l'r'⋘push-xl''r'' = lemma-⋘-push (l⋘ x' x l'⋘r' l''≃r'' r'≃l'') acc-xl''r''
             in left x'' (left x' cl' cr' l'⋘r') (lemma-push-complete-≃ x cl'' cr'' l''≃r'' acc-xl''r'') x'l'r'⋘push-xl''r''
  lemma-push-complete-⋘ x cl cr l⋘r (acc rs) | node right x' (node perfect x'' leaf leaf) leaf | node perfect x''' leaf leaf | x⋘ .x' .x'' .x''' | right .x' (perfect .x'' leaf leaf ≃lf) leaf (⋙p (⋗lf .x'')) | perfect .x''' leaf leaf ≃lf
      with tot≤ x x' | tot≤ x x''' | tot≤ x' x'''
  ... | inj₁ x≤x' | inj₁ x≤x''' | _ = left x (right x' (perfect x'' leaf leaf ≃lf) leaf (⋙p (⋗lf x''))) (perfect x''' leaf leaf ≃lf) (x⋘ x' x'' x''')
  ... | inj₁ x≤x' | inj₂ x'''≤x | _ = left x''' (right x' (perfect x'' leaf leaf ≃lf) leaf (⋙p (⋗lf x''))) (perfect x leaf leaf ≃lf) (x⋘ x' x'' x)
  ... | inj₂ x'≤x | inj₁ x≤x''' | _ =
             let acc-xx'' = rs (node right x (node perfect x'' leaf leaf) leaf) (lemma-≺-left left x (node right x' (node perfect x'' leaf leaf) leaf) (node perfect x''' leaf leaf)) ;
                  cdl = lemma-push-complete-⋙ x (perfect x'' leaf leaf ≃lf) leaf (⋙p (⋗lf x'')) acc-xx''
             in left x' cdl (perfect x''' leaf leaf ≃lf) (lemma-push-⋘ (x⋘ x x'' x''') acc-xx'')
  ... | inj₂ x'≤x | inj₂ x'''≤x | inj₁ x'≤x''' =
             let acc-xx'' = rs (node right x (node perfect x'' leaf leaf) leaf) (lemma-≺-left left x (node right x' (node perfect x'' leaf leaf) leaf) (node perfect x''' leaf leaf)) ;
                  cdl = lemma-push-complete-⋙ x (perfect x'' leaf leaf ≃lf) leaf (⋙p (⋗lf x'')) acc-xx''
             in left x' cdl (perfect x''' leaf leaf ≃lf) (lemma-push-⋘ (x⋘ x x'' x''') acc-xx'')
  ... | inj₂ x'≤x | inj₂ x'''≤x | inj₂ x'''≤x' = left x''' (right x' (perfect x'' leaf leaf ≃lf) leaf (⋙p (⋗lf x''))) (perfect x leaf leaf ≃lf) (x⋘ x' x'' x)
  lemma-push-complete-⋘ x cl cr l⋘r (acc rs) | node right x' l' r' | node perfect x'' l'' r'' | r⋘ .x' .x'' l'⋙r' l''≃r'' l'⋗l'' | right .x' cl' cr' _ | perfect .x'' cl'' cr'' _
      with tot≤ x x' | tot≤ x x'' | tot≤ x' x''
  ... | inj₁ x≤x' | inj₁ x≤x'' | _ = left x (right x' cl' cr' l'⋙r') (perfect x'' cl'' cr'' l''≃r'') (r⋘ x' x'' l'⋙r' l''≃r'' l'⋗l'')
  ... | inj₁ x≤x' | inj₂ x''≤x | _ rewrite lemma-≡-height perfect x x'' l'' r'' =
             let acc-xl''r'' = rs (node perfect x l'' r'') (lemma-≺-right left x (node right x' l' r') (node perfect x'' l'' r'')) ;
                  x'lr'⋘push-xl''r'' = lemma-⋘-push (r⋘ x' x l'⋙r' l''≃r'' l'⋗l'') acc-xl''r''
             in left x'' (right x' cl' cr' l'⋙r') (lemma-push-complete-≃ x cl'' cr'' l''≃r'' acc-xl''r'') x'lr'⋘push-xl''r''
  ... | inj₂ x'≤x | inj₁ x≤x'' | _ rewrite lemma-≡-height right x x' l' r' =
             let acc-xl'r' = rs (node right x l' r') (lemma-≺-left left x (node right x' l' r') (node perfect x'' l'' r'')) ;
                  push-xl'r'⋘x''l''r'' = lemma-push-⋘ (r⋘ x x'' l'⋙r' l''≃r'' l'⋗l'') acc-xl'r'
             in left x' (lemma-push-complete-⋙ x cl' cr' l'⋙r' acc-xl'r') (perfect x'' cl'' cr'' l''≃r'') push-xl'r'⋘x''l''r''
  ... | inj₂ x'≤x | inj₂ x''≤x | inj₁ x'≤x'' rewrite lemma-≡-height right x x' l' r' =
             let acc-xl'r' = rs (node right x l' r') (lemma-≺-left left x (node right x' l' r') (node perfect x'' l'' r'')) ;
                  push-xl'r'⋘x''l''r'' = lemma-push-⋘ (r⋘ x x'' l'⋙r' l''≃r'' l'⋗l'') acc-xl'r'
             in left x' (lemma-push-complete-⋙ x cl' cr' l'⋙r' acc-xl'r') (perfect x'' cl'' cr'' l''≃r'') push-xl'r'⋘x''l''r''
  ... | inj₂ x'≤x | inj₂ x''≤x | inj₂ x''≤x' rewrite lemma-≡-height perfect x x'' l'' r'' =
             let acc-xl''r'' = rs (node perfect x l'' r'') (lemma-≺-right left x (node right x' l' r') (node perfect x'' l'' r'')) ;
                   x'lr'⋘push-xl''r'' = lemma-⋘-push (r⋘ x' x l'⋙r' l''≃r'' l'⋗l'') acc-xl''r''
             in left x'' (right x' cl' cr' l'⋙r') (lemma-push-complete-≃ x cl'' cr'' l''≃r'' acc-xl''r'') x'lr'⋘push-xl''r''

lemma-push-complete : {t : PLRTree} → Complete t → (acc : Acc _≺_ t) → Complete (push t acc)
lemma-push-complete leaf _ = leaf
lemma-push-complete (perfect {l} {r}x cl cr l≃r) (acc rs) = lemma-push-complete-≃ x cl cr l≃r (acc rs)
lemma-push-complete (left {l} {r}x cl cr l⋘r) (acc rs) = lemma-push-complete-⋘ x cl cr l⋘r (acc rs)
lemma-push-complete (right {l} {r}x cl cr l⋙r) (acc rs) = lemma-push-complete-⋙ x cl cr l⋙r (acc rs)


module SortDependingOnIndex where

open import Common.Level

data Bad : (l : Level) → Set l where


module LiftGet where

open import Data.Unit using (⊤ ; tt)
open import Data.Nat using (ℕ ; suc)
open import Data.Vec using (Vec ; toList ; fromList) renaming ([] to []V ; _∷_ to _∷V_ ; map to mapV)
open import Data.List using (List ; [] ; _∷_ ; length ; replicate ; map)
open import Data.List.Properties using (length-map)
open import Data.Product using (∃ ; _,_ ; proj₁ ; proj₂)
open import Function using (_∘_ ; flip ; const)
open import Relation.Binary.Core using (_≡_)
open import Relation.Binary.PropositionalEquality using (_≗_ ; sym ; cong ; refl ; subst ; trans ; proof-irrelevance ; module ≡-Reasoning)
open import Relation.Binary.HeterogeneousEquality as H using (module ≅-Reasoning ; _≅_ ; ≅-to-≡ ; ≡-to-≅ ; ≡-subst-removable) renaming (refl to het-refl ; sym to het-sym ; cong to het-cong ; reflexive to het-reflexive)

import FreeTheorems
open import Generic using (length-replicate ; toList-fromList ; toList-subst)
open FreeTheorems.ListList using (get-type) renaming (free-theorem to free-theoremL ; Get to GetL ; module Get to GetL)
open FreeTheorems.VecVec using () renaming (get-type to getV-type ; Get to GetV ; module Get to GetV)

getVec-to-getList : {getlen : ℕ → ℕ} → (getV-type getlen) → get-type
getVec-to-getList get = toList ∘ get ∘ fromList

fromList∘map : {α β : Set} → (f : α → β) → (l : List α) → fromList (map f l) ≅ mapV f (fromList l)
fromList∘map f []       = het-refl
fromList∘map f (x ∷ xs) = H.cong₂ (λ n → _∷V_ {n = n} (f x)) (H.reflexive (length-map f xs)) (fromList∘map f xs)

toList∘map : {α β : Set} {n : ℕ} → (f : α → β) → (v : Vec α n) → toList (mapV f v) ≡ map f (toList v)
toList∘map f []V       = refl
toList∘map f (x ∷V xs) = cong (_∷_ (f x)) (toList∘map f xs)

GetV-to-GetL : GetV → GetL
GetV-to-GetL getrecord = record { get = toList ∘ get ∘ fromList; free-theorem = ft }
  where open GetV getrecord
        open ≡-Reasoning
        ft : {α β : Set} → (f : α → β) → (xs : List α) → toList (get (fromList (map f xs))) ≡ map f (toList (get (fromList xs)))
        ft f xs = begin
          toList (get (fromList (map f xs)))
            ≅⟨ H.cong₂ {B = Vec _} (λ n → toList ∘ get) (het-reflexive (length-map f xs)) (fromList∘map f xs) ⟩
          toList (get (mapV f (fromList xs)))
            ≡⟨ cong toList (free-theorem f (fromList xs)) ⟩
          toList (mapV f (get (fromList xs)))
            ≡⟨ toList∘map f (get (fromList xs)) ⟩
          map f (toList (get (fromList xs))) ∎

getList-to-getlen : get-type → ℕ → ℕ
getList-to-getlen get = length ∘ get ∘ flip replicate tt

replicate-length : {A : Set} → (l : List A) → map (const tt) l ≡ replicate (length l) tt
replicate-length [] = refl
replicate-length (_ ∷ l) = cong (_∷_ tt) (replicate-length l)

getList-length : (get : get-type) → {B : Set} → (l : List B) → length (get l) ≡ getList-to-getlen get (length l)
getList-length get l = begin
  length (get l)
    ≡⟨ sym (length-map (const tt) (get l)) ⟩
  length (map (const tt) (get l))
    ≡⟨ cong length (sym (free-theoremL get (const tt) l)) ⟩
  length (get (map (const tt) l))
    ≡⟨ cong (length ∘ get) (replicate-length l) ⟩
  length (get (replicate (length l) tt)) ∎
  where open ≡-Reasoning

length-toList : {A : Set} {n : ℕ} → (v : Vec A n) → length (toList v) ≡ n
length-toList []V = refl
length-toList (x ∷V xs) = cong suc (length-toList xs)

getList-to-getVec-length-property : (get : get-type) → {C : Set} → {m : ℕ} → (v : Vec C m) → length (get (toList v)) ≡ length (get (replicate m tt))
getList-to-getVec-length-property get {_} {m} v = begin
    length (get (toList v))
      ≡⟨ getList-length get (toList v) ⟩
    length (get (replicate (length (toList v)) tt))
      ≡⟨ cong (length ∘ get ∘ flip replicate tt) (length-toList v) ⟩
    length (get (replicate m tt)) ∎
    where open ≡-Reasoning

getList-to-getVec : get-type → ∃ λ (getlen : ℕ → ℕ) → (getV-type getlen)
getList-to-getVec get = getlen , get'
  where getlen : ℕ → ℕ
        getlen = getList-to-getlen get
        get' : {C : Set} {m : ℕ} → Vec C m → Vec C (getlen m)
        get' {C} v = subst (Vec C) (getList-to-getVec-length-property get v) (fromList (get (toList v)))

private
  module GetV-Implementation (getrecord : GetL) where

    open GetL getrecord

    getlen = length ∘ get ∘ flip replicate tt

    length-property : {C : Set} {m : ℕ} → (s : Vec C m) → length (get (toList s)) ≡ getlen m
    length-property = getList-to-getVec-length-property get

    getV : {C : Set} {m : ℕ} → Vec C m → Vec C (getlen m)
    getV s = subst (Vec _) (length-property s) (fromList (get (toList s)))

    ft : {α β : Set} (f : α → β) {n : ℕ} (v : Vec α n) → getV (mapV f v) ≡ mapV f (getV v)
    ft f v = ≅-to-≡ (begin
      subst (Vec _) (length-property (mapV f v)) (fromList (get (toList (mapV f v))))
        ≅⟨ ≡-subst-removable (Vec _) (length-property (mapV f v)) (fromList (get (toList (mapV f v)))) ⟩
      fromList (get (toList (mapV f v)))
        ≅⟨ het-cong (fromList ∘ get) (het-reflexive (toList∘map f v)) ⟩
      fromList (get (map f (toList v)))
        ≅⟨ het-cong fromList (het-reflexive (free-theorem f (toList v))) ⟩
      fromList (map f (get (toList v)))
        ≅⟨ fromList∘map f (get (toList v)) ⟩
      mapV f (fromList (get (toList v)))
        ≅⟨ H.cong₂ (λ n → mapV {n = n} f) (H.reflexive (length-property v)) (H.sym (≡-subst-removable (Vec _) (length-property v) (fromList (get (toList v))))) ⟩
      mapV f (subst (Vec _) (length-property v) (fromList (get (toList v)))) ∎)
      where open ≅-Reasoning

GetL-to-GetV : GetL → GetV
GetL-to-GetV getrecord = record { getlen = getlen; get = getV; free-theorem = ft }
  where open GetV-Implementation getrecord

get-commut-1-≅ : (get : get-type) {A : Set} → (l : List A) → fromList (get l) ≅ proj₂ (getList-to-getVec get) (fromList l)
get-commut-1-≅ get l = begin
  fromList (get l)
    ≅⟨ het-cong (fromList ∘ get) (≡-to-≅ (sym (toList-fromList l))) ⟩
  fromList (get (toList (fromList l)))
    ≅⟨ het-sym (≡-subst-removable (Vec _) (getList-to-getVec-length-property get (fromList l)) (fromList (get (toList (fromList l))))) ⟩
  subst (Vec _) (getList-to-getVec-length-property get (fromList l)) (fromList (get (toList (fromList l)))) ∎
  where open ≅-Reasoning

get-commut-1 : (get : get-type) {A : Set} → (l : List A) → fromList (get l) ≡ subst (Vec A) (sym (getList-length get l)) (proj₂ (getList-to-getVec get) (fromList l))
get-commut-1 get {A} l = ≅-to-≡ (begin
  fromList (get l)
    ≅⟨ get-commut-1-≅ get l ⟩
  proj₂ (getList-to-getVec get) (fromList l)
    ≅⟨ het-sym (≡-subst-removable (Vec _) (sym (getList-length get l)) (proj₂ (getList-to-getVec get) (fromList l))) ⟩
  subst (Vec _) (sym (getList-length get l)) (proj₂ (getList-to-getVec get) (fromList l)) ∎)
  where open ≅-Reasoning

get-trafo-1 : (get : get-type) → {B : Set} → getVec-to-getList (proj₂ (getList-to-getVec get)) {B} ≗ get {B}
get-trafo-1 get {B} l = begin
  getVec-to-getList (proj₂ (getList-to-getVec get)) l
    ≡⟨ refl ⟩
  toList (proj₂ (getList-to-getVec get) (fromList l))
    ≡⟨ refl ⟩
  toList (subst (Vec B) (getList-to-getVec-length-property get (fromList l)) (fromList (get (toList (fromList l)))))
    ≡⟨ toList-subst (fromList (get (toList (fromList l)))) (getList-to-getVec-length-property get (fromList l)) ⟩
  toList (fromList (get (toList (fromList l))))
    ≡⟨ toList-fromList (get (toList (fromList l))) ⟩
  get (toList (fromList l))
    ≡⟨ cong get (toList-fromList l) ⟩
  get l ∎
  where open ≡-Reasoning

GetLVL-identity : (G : GetL) → {A : Set} → GetL.get (GetV-to-GetL (GetL-to-GetV G)) ≗ GetL.get G {A}
GetLVL-identity G = get-trafo-1 (GetL.get G)

vec-len : {A : Set} {n : ℕ} → Vec A n → ℕ
vec-len {_} {n} _ = n

fromList-toList : {A : Set} {n : ℕ} → (v : Vec A n) → fromList (toList v) ≅ v
fromList-toList []V       = het-refl
fromList-toList (x ∷V xs) = H.cong₂ (λ n → _∷V_ {n = n} x) (het-reflexive (length-toList xs)) (fromList-toList xs)

get-commut-2 : {getlen : ℕ → ℕ} → (get : getV-type getlen) → {B : Set} {n : ℕ} → (toList ∘ get {B} {n}) ≗ (getVec-to-getList get) ∘ toList
get-commut-2 get {B} v = sym (≅-to-≡ (H.cong₂ (λ n → toList ∘ get {n = n}) (H.reflexive (length-toList v)) (fromList-toList v)))

get-trafo-2-getlen : {getlen : ℕ → ℕ} → (get : getV-type getlen) → proj₁ (getList-to-getVec (getVec-to-getList get)) ≗ getlen
get-trafo-2-getlen {getlen} get n = begin
  proj₁ (getList-to-getVec (getVec-to-getList get)) n
    ≡⟨ refl ⟩
  length (toList (get (fromList (replicate n tt))))
    ≡⟨ length-toList (get (fromList (replicate n tt))) ⟩
  vec-len (get (fromList (replicate n tt)))
    ≡⟨ cong getlen (length-replicate n) ⟩
  getlen n ∎
  where open ≡-Reasoning

get-trafo-2-get-≅ : {getlen : ℕ → ℕ} → (get : getV-type getlen) → {B : Set} {n : ℕ} → (v : Vec B n) → proj₂ (getList-to-getVec (getVec-to-getList get)) v ≅ get v
get-trafo-2-get-≅ {getlen} get v = begin
  subst (Vec _) (getList-to-getVec-length-property (getVec-to-getList get) v) (fromList (toList (get (fromList (toList v)))))
    ≅⟨ ≡-subst-removable (Vec _) (getList-to-getVec-length-property (getVec-to-getList get) v) (fromList (toList (get (fromList (toList v))))) ⟩
  fromList (toList (get (fromList (toList v))))
    ≅⟨ fromList-toList (get (fromList (toList v))) ⟩
  get (fromList (toList v))
    ≅⟨ H.cong₂ (λ n → get {n = n}) (H.reflexive (length-toList v)) (fromList-toList v) ⟩
  get v ∎
  where open ≅-Reasoning

get-trafo-2-get : {getlen : ℕ → ℕ} → (get : getV-type getlen) → {B : Set} {n : ℕ} → proj₂ (getList-to-getVec (getVec-to-getList get)) ≗ subst (Vec B) (sym (get-trafo-2-getlen get n)) ∘ get
get-trafo-2-get get v = ≅-to-≡ (begin
  proj₂ (getList-to-getVec (getVec-to-getList get)) v
    ≅⟨ get-trafo-2-get-≅ get v ⟩
  get v
    ≅⟨ het-sym (≡-subst-removable (Vec _) (sym (get-trafo-2-getlen get (vec-len v))) (get v)) ⟩
  subst (Vec _) (sym (get-trafo-2-getlen get (vec-len v))) (get v) ∎)
  where open ≅-Reasoning


{- Byzantine Fault Tolerant Consensus Verification in Agda, version 0.9.

   Copyright (c) 2020, 2021, Oracle and/or its affiliates.
   Licensed under the Universal Permissive License v 1.0 as shown at https://opensource.oracle.com/licenses/upl
-}

open import LibraBFT.Abstract.Types
open import LibraBFT.Abstract.Types.EpochConfig
open import Util.Lemmas
open import Util.Prelude
open        WithAbsVote

-- For each desired property (VotesOnce and PreferredRoundRule), we have a
-- module containing a Type that defines a property that an implementation
-- should prove, and a proof that it implies the corresponding rule used by
-- the abstract proofs.  Then, we use those proofs to instantiate thmS5,
-- and the use thmS5 to prove a number of correctness conditions.
--
-- TODO-1: refactor this file to separate the definitions and proofs of
-- VotesOnce and PreferredRoundRule from their use in proving the correctness
-- properties.

module LibraBFT.Abstract.Properties
  (UID    : Set)
  (_≟UID_ : (u₀ u₁ : UID) → Dec (u₀ ≡ u₁))
  (NodeId : Set)
  (𝓔  : EpochConfig UID NodeId)
  (𝓥  : VoteEvidence UID NodeId 𝓔)
  where

 open import LibraBFT.Abstract.Records                 UID _≟UID_ NodeId 𝓔 𝓥
 open import LibraBFT.Abstract.Records.Extends         UID _≟UID_ NodeId 𝓔 𝓥
 open import LibraBFT.Abstract.RecordChain             UID _≟UID_ NodeId 𝓔 𝓥
 open import LibraBFT.Abstract.RecordChain.Assumptions UID _≟UID_ NodeId 𝓔 𝓥
 open import LibraBFT.Abstract.System                  UID _≟UID_ NodeId 𝓔 𝓥
 open import LibraBFT.Abstract.RecordChain.Properties  UID _≟UID_ NodeId 𝓔 𝓥
 open        EpochConfig 𝓔

 module WithAssumptions {ℓ}
   (InSys               : Record → Set ℓ)
   (no-collisions-InSys : NoCollisions InSys)
   (votes-once          : VotesOnlyOnceRule InSys)
   (preferred-round     : PreferredRoundRule InSys)
  where

   open All-InSys-props InSys

   CommitsDoNotConflict : ∀{q q'}
        → {rc  : RecordChain (Q q)}  → All-InSys rc
        → {rc' : RecordChain (Q q')} → All-InSys rc'
        → {b b' : Block}
        → CommitRule rc  b
        → CommitRule rc' b'
        → (B b) ∈RC rc' ⊎ (B b') ∈RC rc
   CommitsDoNotConflict ais ais' cr cr'
      with WithInvariants.thmS5 InSys votes-once preferred-round ais ais' cr cr'
       -- We use the implementation-provided evidence that Block ids are injective among
       -- Block actually in the system to dismiss the first possibility
   ...| inj₁ ((_ , neq , h≡) , (is1 , is2)) = ⊥-elim (neq (no-collisions-InSys is1 is2 h≡))
   ...| inj₂ corr = corr

   -- When we are dealing with a /Complete/ InSys predicate, we can go a few steps
   -- further and prove that commits do not conflict even if we have only partial
   -- knowledge about Records represented in the system.
   module _ (∈QC⇒AllSent : Complete InSys) where

    -- For a /complete/ system (i.e., one in which peers vote for a Block only if
    -- they know of a RecordChain up to that Block whose Records are all InSys), we
    -- can prove that CommitRules based on RecordChainFroms similarly do not
    -- conflict, provided all of the Records in the RecordChainFroms are InSys.
    -- This enables peers not participating in consensus to confirm commits even if
    -- they are sent only a "commit certificate" that contains enough of a
    -- RecordChain to confirm the CommitRule.  Note that it is this "sending" that
    -- justfies the assumption that the RecordChainFroms on which the CommitRules
    -- are based are All-InSys.
    CommitsDoNotConflict'
      : ∀{o o' q q'}
      → {rcf  : RecordChainFrom o  (Q q)}  → All-InSys rcf
      → {rcf' : RecordChainFrom o' (Q q')} → All-InSys rcf'
      → {b b' : Block}
      → CommitRuleFrom rcf  b
      → CommitRuleFrom rcf' b'
      → Σ (RecordChain (Q q')) ((B b)  ∈RC_)
      ⊎ Σ (RecordChain (Q q))  ((B b') ∈RC_)
    CommitsDoNotConflict' {cb} {q = q} {q'} {rcf} rcfAll∈sys {rcf'} rcf'All∈sys crf crf'
       with bft-property (qVotes-C1 q) (qVotes-C1 q')
    ...| α , α∈qmem , α∈q'mem , hα
       with Any-sym (Any-map⁻ α∈qmem) | Any-sym (Any-map⁻ α∈q'mem)
    ...| α∈q | α∈q'
       with ∈QC⇒AllSent {q = q} hα α∈q (rcfAll∈sys here) | ∈QC⇒AllSent {q = q'} hα α∈q' (rcf'All∈sys here)
    ...| ab , (arc , ais) , ab←q | ab' , (arc' , ais') , ab←q'
      with crf⇒cr rcf (step arc ab←q) crf | crf⇒cr rcf' (step arc' ab←q') crf'
    ...| inj₁ ((_ , neq , h≡) , (is1 , is2)) | _                     = ⊥-elim (neq (no-collisions-InSys (rcfAll∈sys  is1) (ais  (∈RC-simple-¬here arc  ab←q  (λ ()) is2)) h≡))
    ...| inj₂ _                | inj₁ ((_ , neq , h≡) , (is1 , is2)) = ⊥-elim (neq (no-collisions-InSys (rcf'All∈sys is1) (ais' (∈RC-simple-¬here arc' ab←q' (λ ()) is2)) h≡))
    ...| inj₂ cr               | inj₂ cr'
      with CommitsDoNotConflict (All-InSys-step ais ab←q (rcfAll∈sys here)) (All-InSys-step ais' ab←q' (rcf'All∈sys here)) cr cr'
    ...| inj₁ b∈arc' = inj₁ (step arc' ab←q' , b∈arc')
    ...| inj₂ b'∈arc = inj₂ (step arc  ab←q  , b'∈arc)


-- We define ZigZag-complete relations and prove that quasi equivalence relations
-- give rise to equivalences on the set quotients.
{-# OPTIONS --cubical --no-import-sorts --safe #-}
module Cubical.Relation.ZigZag.Base where

open import Cubical.Core.Everything
open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Function
open import Cubical.Foundations.Isomorphism
open import Cubical.Foundations.HLevels
open import Cubical.Data.Sigma
open import Cubical.HITs.SetQuotients
open import Cubical.HITs.PropositionalTruncation as Trunc
open import Cubical.Relation.Binary.Base

open isEquivRel

private
 variable
  ℓ ℓ' : Level

isZigZagComplete : {A B : Type ℓ} (R : A → B → Type ℓ') → Type (ℓ-max ℓ ℓ')
isZigZagComplete R = ∀ {a b a' b'} → R a b → R a' b → R a' b' → R a b'

ZigZagRel : (A B : Type ℓ) (ℓ' : Level) → Type (ℓ-max ℓ (ℓ-suc ℓ'))
ZigZagRel A B ℓ' = Σ[ R ∈ (A → B → Type ℓ') ] (isZigZagComplete R)

record isQuasiEquivRel {A B : Type ℓ} (R : A → B → Type ℓ') : Type (ℓ-max ℓ ℓ') where
  field
    zigzag : isZigZagComplete R
    fwd : (a : A) → ∃[ b ∈ B ] R a b
    bwd : (b : B) → ∃[ a ∈ A ] R a b

open isQuasiEquivRel

QuasiEquivRel : (A B : Type ℓ) (ℓ' : Level) → Type (ℓ-max ℓ (ℓ-suc ℓ'))
QuasiEquivRel A B ℓ' =
  Σ[ R ∈ PropRel A B ℓ' ] isQuasiEquivRel (R .fst)

invQER : {A B : Type ℓ} {ℓ' : Level} → QuasiEquivRel A B ℓ' → QuasiEquivRel B A ℓ'
invQER (R , qer) .fst = invPropRel R
invQER (R , qer) .snd .zigzag aRb aRb' a'Rb' = qer .zigzag a'Rb' aRb' aRb
invQER (R , qer) .snd .fwd = qer .bwd
invQER (R , qer) .snd .bwd = qer .fwd

QER→EquivRel : {A B : Type ℓ}
  → QuasiEquivRel A B ℓ' → EquivPropRel A (ℓ-max ℓ ℓ')
QER→EquivRel (R , sim) .fst = compPropRel R (invPropRel R)
QER→EquivRel (R , sim) .snd .reflexive a = Trunc.map (λ {(b , r) → b , r , r}) (sim .fwd a)
QER→EquivRel (R , sim) .snd .symmetric _ _ = Trunc.map (λ {(b , r₀ , r₁) → b , r₁ , r₀})
QER→EquivRel (R , sim) .snd .transitive _ _ _ =
  Trunc.map2 (λ {(b , r₀ , r₁) (b' , r₀' , r₁') → b , r₀ , sim .zigzag r₁' r₀' r₁})

-- The following result is due to Carlo Angiuli
module QER→Equiv {A B : Type ℓ} (R : QuasiEquivRel A B ℓ') where

  Rᴸ = QER→EquivRel R .fst .fst
  Rᴿ = QER→EquivRel (invQER R) .fst .fst

  private
    sim = R .snd

  private
    f : (a : A) → ∃[ b ∈ B ] R .fst .fst a b → B / Rᴿ
    f a =
      Trunc.rec→Set squash/
        ([_] ∘ fst)
        (λ {(b , r) (b' , r') → eq/ b b' ∣ a , r , r' ∣})

    fPath :
      (a₀ : A) (s₀ : ∃[ b ∈ B ] R .fst .fst a₀ b)
      (a₁ : A) (s₁ : ∃[ b ∈ B ] R .fst .fst a₁ b)
      → Rᴸ a₀ a₁
      → f a₀ s₀ ≡ f a₁ s₁
    fPath a₀ =
      Trunc.elim (λ _ → isPropΠ3 λ _ _ _ → squash/ _ _)
        (λ {(b₀ , r₀) a₁ →
          Trunc.elim (λ _ → isPropΠ λ _ → squash/ _ _)
            (λ {(b₁ , r₁) →
              Trunc.elim (λ _ → squash/ _ _)
                (λ {(b' , r₀' , r₁') → eq/ b₀ b₁ ∣ a₀ , r₀ , sim .zigzag r₀' r₁' r₁ ∣})})})

    φ : A / Rᴸ → B / Rᴿ
    φ [ a ] = f a (sim .fwd a)
    φ (eq/ a₀ a₁ r i) =  fPath a₀ (sim .fwd a₀) a₁ (sim .fwd a₁) r i
    φ (squash/ _ _ p q j i) = squash/ _ _ (cong φ p) (cong φ q) j i

  relToFwd≡ : ∀ {a b} → R .fst .fst a b → φ [ a ] ≡ [ b ]
  relToFwd≡ {a} {b} r =
    Trunc.elim {P = λ s → f a s ≡ [ b ]} (λ _ → squash/ _ _)
      (λ {(b' , r') → eq/ b' b ∣ a , r' , r ∣})
      (sim .fwd a)

  fwd≡ToRel : ∀ {a b} → φ [ a ] ≡ [ b ] → R .fst .fst a b
  fwd≡ToRel {a} {b} =
    Trunc.elim {P = λ s → f a s ≡ [ b ] → R .fst .fst a b}
      (λ _ → isPropΠ λ _ → R .fst .snd _ _)
      (λ {(b' , r') p →
        Trunc.rec (R .fst .snd _ _)
          (λ {(a' , s' , s) → R .snd .zigzag r' s' s})
          (effective
            (QER→EquivRel (invQER R) .fst .snd)
            (QER→EquivRel (invQER R) .snd)
            b' b p)})
      (sim .fwd a)

  private
    g : (b : B) → ∃[ a ∈ A ] R .fst .fst a b → A / Rᴸ
    g b =
      Trunc.rec→Set squash/
        ([_] ∘ fst)
        (λ {(a , r) (a' , r') → eq/ a a' ∣ b , r , r' ∣})

    gPath :
      (b₀ : B) (s₀ : ∃[ a ∈ A ] R .fst .fst a b₀)
      (b₁ : B) (s₁ : ∃[ a ∈ A ] R .fst .fst a b₁)
      → Rᴿ b₀ b₁
      → g b₀ s₀ ≡ g b₁ s₁
    gPath b₀ =
      Trunc.elim (λ _ → isPropΠ3 λ _ _ _ → squash/ _ _)
        (λ {(a₀ , r₀) b₁ →
          Trunc.elim (λ _ → isPropΠ λ _ → squash/ _ _)
            (λ {(a₁ , r₁) →
              Trunc.elim (λ _ → squash/ _ _)
                (λ {(a' , r₀' , r₁') → eq/ a₀ a₁ ∣ b₀ , r₀ , sim .zigzag r₁ r₁' r₀' ∣})})})

    ψ : B / Rᴿ → A / Rᴸ
    ψ [ b ] = g b (sim .bwd b)
    ψ (eq/ b₀ b₁ r i) = gPath b₀ (sim .bwd b₀) b₁ (sim .bwd b₁) r i
    ψ (squash/ _ _ p q j i) = squash/ _ _ (cong ψ p) (cong ψ q) j i

  relToBwd≡ : ∀ {a b} → R .fst .fst a b → ψ [ b ] ≡ [ a ]
  relToBwd≡ {a} {b} r =
    Trunc.elim {P = λ s → g b s ≡ [ a ]} (λ _ → squash/ _ _)
      (λ {(a' , r') → eq/ a' a ∣ b , r' , r ∣})
      (sim .bwd b)

  private
    η : ∀ qb → φ (ψ qb) ≡ qb
    η =
      elimProp (λ _ → squash/ _ _)
        (λ b →
          Trunc.elim {P = λ s → φ (g b s) ≡ [ b ]} (λ _ → squash/ _ _)
            (λ {(a , r) → relToFwd≡ r})
            (sim .bwd b))

    ε : ∀ qa → ψ (φ qa) ≡ qa
    ε =
      elimProp (λ _ → squash/ _ _)
        (λ a →
          Trunc.elim {P = λ s → ψ (f a s) ≡ [ a ]} (λ _ → squash/ _ _)
            (λ {(b , r) → relToBwd≡ r})
            (sim .fwd a))

  bwd≡ToRel : ∀ {a b} → ψ [ b ] ≡ [ a ] → R .fst .fst a b
  bwd≡ToRel {a} {b} p = fwd≡ToRel (cong φ (sym p) ∙ η [ b ])

  Thm : (A / Rᴸ) ≃ (B / Rᴿ)
  Thm = isoToEquiv (iso φ ψ η ε)


open import MLib.Algebra.PropertyCode
open import MLib.Algebra.PropertyCode.Structures

module MLib.Matrix.Mul {c ℓ} (struct : Struct bimonoidCode c ℓ) where

open import MLib.Prelude
open import MLib.Matrix.Core
open import MLib.Matrix.Equality struct
open import MLib.Matrix.Plus struct
open import MLib.Algebra.Operations struct

open FunctionProperties
open Table using (head; tail; rearrange; fromList; toList; _≗_)

1● : ∀ {n} → Matrix S n n
1● i j with i Fin.≟ j
1● i j | yes _ = 1′
1● i j | no  _ = 0′

infixl 7 _⊗_

_⊗_ : ∀ {m n o} → Matrix S m n → Matrix S n o → Matrix S m o
_⊗_ {n = n} A B i k = ∑[ j < n ] (A i j *′ B j k)

⊗-cong : ∀ {m n o} {A A′ : Matrix S m n} {B B′ : Matrix S n o} → A ≈ A′ → B ≈ B′ → (A ⊗ B) ≈ (A′ ⊗ B′)
⊗-cong A≈A′ B≈B′ i k = sumₜ-cong (λ j → cong * (A≈A′ i j) (B≈B′ j k))

open _≃_

1●-cong-≃ : ∀ {m n} → m ≡ n → 1● {m} ≃ 1● {n}
1●-cong-≃ ≡.refl = ≃-refl

⊗-cong-≃ : ∀ {m n o m′ n′ o′} (A : Matrix S m n) (B : Matrix S n o) (A′ : Matrix S m′ n′) (B′ : Matrix S n′ o′) → A ≃ A′ → B ≃ B′ → (A ⊗ B) ≃ (A′ ⊗ B′)
⊗-cong-≃ A B A′ B′ p q .m≡p = p .m≡p
⊗-cong-≃ A B A′ B′ p q .n≡q = q .n≡q
⊗-cong-≃ {n = n} {n′ = n′} A B A′ B′ p q .equal {i} {i′} {k} {k′} i≅i′ k≅k′ =
  begin
    (A  ⊗ B ) i k                       ≡⟨⟩
    ∑[ j  < n  ] (A  i  j  *′ B  j  k)  ≈⟨ sumₜ-cong′ {n} {n′} (p .n≡q , λ _ _ j≅j′ → cong * (p .equal i≅i′ j≅j′) (q .equal j≅j′ k≅k′)) ⟩
    ∑[ j′ < n′ ] (A′ i′ j′ *′ B′ j′ k′) ≡⟨⟩
    (A′ ⊗ B′) i′ k′                     ∎
  where
    open EqReasoning S.setoid

⊗-assoc :
  ⦃ props : Has ( * ⟨ distributesOverˡ ⟩ₚ +
                ∷ * ⟨ distributesOverʳ ⟩ₚ +
                ∷ associative on *
                ∷ 0# is leftZero for *
                ∷ 0# is rightZero for *
                ∷ 0# is leftIdentity for +
                ∷ associative on +
                ∷ commutative on +
                ∷ []) ⦄
  → ∀ {m n p q} (A : Matrix S m n) (B : Matrix S n p) (C : Matrix S p q)
  → ((A ⊗ B) ⊗ C) ≈ (A ⊗ (B ⊗ C))
⊗-assoc ⦃ props ⦄ {m} {n} {p} {q} A B C i l =
  begin
    ((A ⊗ B) ⊗ C) i l                                    ≡⟨⟩
    ∑[ k < p ] (∑[ j < n ] (A i j *′ B j k) *′ C k l)     ≈⟨ sumₜ-cong {p} (λ k → sumDistribʳ ⦃ weaken props ⦄ {n} _ _) ⟩
    ∑[ k < p ] (∑[ j < n ] ((A i j *′ B j k) *′ C k l))   ≈⟨ sumₜ-cong {p} (λ k → sumₜ-cong {n} (λ j → from props (associative on *) _ _ _)) ⟩
    ∑[ k < p ] (∑[ j < n ] (A i j *′ (B j k *′ C k l)))   ≈⟨ ∑-comm ⦃ weaken props ⦄ p n _ ⟩
    ∑[ j < n ] (∑[ k < p ] (A i j *′ (B j k *′ C k l)))   ≈⟨ sumₜ-cong {n} (λ j → S.sym (sumDistribˡ ⦃ weaken props ⦄ {p} _ _)) ⟩
    ∑[ j < n ] (A i j *′ ∑[ k < p ] (B j k *′ C k l))     ≡⟨⟩
    (A ⊗ (B ⊗ C)) i l                                    ∎
  where open EqReasoning S.setoid

1-*-comm :
  ⦃ props : Has (1# is leftIdentity for * ∷ 1# is rightIdentity for * ∷ 0# is leftZero for * ∷ 0# is rightZero for * ∷ []) ⦄ →
  ∀ {n} (i j : Fin n) x → 1● i j *′ x ≈′ x *′ 1● i j
1-*-comm i j x with i Fin.≟ j
1-*-comm ⦃ props ⦄ i j x | yes p = S.trans (from props (1# is leftIdentity for *) _) (S.sym (from props (1# is rightIdentity for *) _))
1-*-comm ⦃ props ⦄ i j x | no ¬p = S.trans (from props (0# is leftZero for *) _) (S.sym (from props (0# is rightZero for *) _))

1-selectˡ :
  ⦃ props : Has (1# is leftIdentity for * ∷ 0# is leftZero for * ∷ []) ⦄ →
  ∀ {n} (i : Fin n) t j → (1● i j *′ lookup t j) ≈′ lookup (Table.select 0′ i t) j
1-selectˡ i t j with i Fin.≟ j | j Fin.≟ i
1-selectˡ ⦃ props ⦄ i t .i | yes ≡.refl | yes q = from props (1# is leftIdentity for *) _
1-selectˡ .j t j | yes ≡.refl | no ¬q = ⊥-elim (¬q ≡.refl)
1-selectˡ i t .i | no ¬p | yes ≡.refl = ⊥-elim (¬p ≡.refl)
1-selectˡ ⦃ props ⦄ i t j | no _ | no ¬p = from props (0# is leftZero for *) _

1-selectʳ :
  ⦃ props : Has (1# is rightIdentity for * ∷ 0# is rightZero for * ∷ []) ⦄ →
  ∀ {n} (i : Fin n) t j → (lookup t j *′ 1● j i) ≈′ lookup (Table.select 0′ i t) j
1-selectʳ i t j with i Fin.≟ j | j Fin.≟ i
1-selectʳ ⦃ props ⦄ i t .i | yes ≡.refl | yes q = from props (1# is rightIdentity for *) _
1-selectʳ .j t j | yes ≡.refl | no ¬q = ⊥-elim (¬q ≡.refl)
1-selectʳ i t .i | no ¬p | yes ≡.refl = ⊥-elim (¬p ≡.refl)
1-selectʳ ⦃ props ⦄ i t j | no _ | no ¬p = from props (0# is rightZero for *) _

1-sym : ∀ {n} (i j : Fin n) → 1● i j ≈′ 1● j i
1-sym i j with i Fin.≟ j | j Fin.≟ i
1-sym i j | yes _ | yes _ = S.refl
1-sym i j | no _  | no _ = S.refl
1-sym i .i | yes ≡.refl | no ¬q = ⊥-elim (¬q ≡.refl)
1-sym i .i | no ¬p | yes ≡.refl = ⊥-elim (¬p ≡.refl)

⊗-identityˡ :
  ⦃ props : Has ( 1# is leftIdentity for *
                ∷ 0# is leftZero for *
                ∷ 0# is leftIdentity for +
                ∷ 0# is rightIdentity for +
                ∷ associative on +
                ∷ commutative on +
                ∷ []) ⦄ →
  ∀ {m n} → ∀ (A : Matrix S m n) → (1● ⊗ A) ≈ A
⊗-identityˡ ⦃ props ⦄ {m} A i k =
  begin
    ∑[ j < m ] (1● i j *′ A j k)                        ≈⟨ sumₜ-cong (1-selectˡ ⦃ weaken props ⦄ i _) ⟩
    sumₜ (Table.select 0′ i (tabulate (λ x → A x k)))   ≈⟨ select-sum ⦃ weaken props ⦄ {m} _ ⟩
    A i k                                               ∎
  where open EqReasoning S.setoid

⊗-identityʳ :
  ⦃ props : Has ( 1# is rightIdentity for *
                ∷ 0# is rightZero for *
                ∷ 0# is leftIdentity for +
                ∷ 0# is rightIdentity for +
                ∷ associative on +
                ∷ commutative on +
                ∷ []) ⦄ →
  ∀ {m n} → ∀ (A : Matrix S m n) → (A ⊗ 1●) ≈ A
⊗-identityʳ ⦃ props ⦄ {n = n} A i k =
  begin
    ∑[ j < n ] (A i j *′ 1● j k)                ≈⟨ sumₜ-cong (1-selectʳ ⦃ weaken props ⦄ k _) ⟩
    sumₜ (Table.select 0′ k (tabulate (A i)))   ≈⟨ select-sum ⦃ weaken props ⦄ {n} _ ⟩
    A i k                                       ∎
  where open EqReasoning S.setoid

⊗-distributesOverˡ-⊕ :
  ⦃ props : Has (* ⟨ distributesOverˡ ⟩ₚ + ∷ 0# is leftIdentity for + ∷ associative on + ∷ commutative on + ∷ []) ⦄ →
  ∀ {m n o} (M : Matrix S m n) (A B : Matrix S n o) →
  M ⊗ (A ⊕ B) ≈ (M ⊗ A) ⊕ (M ⊗ B)
⊗-distributesOverˡ-⊕ ⦃ props ⦄ {n = n} M A B i k =
  begin
    ∑[ j < n ] (M i j *′ (A j k +′ B j k))                      ≈⟨ sumₜ-cong (λ j → from props (* ⟨ distributesOverˡ ⟩ₚ +) (M i j) (A j k) (B j k)) ⟩
    ∑[ j < n ] (M i j *′ A j k +′ M i j *′ B j k)               ≈⟨ S.sym (∑-+′-hom ⦃ weaken props ⦄ n (λ j → M i j *′ A j k) (λ j → M i j *′ B j k)) ⟩
    ∑[ j < n ] (M i j *′ A j k) +′ ∑[ j < n ] (M i j *′ B j k)  ∎
  where open EqReasoning S.setoid


module Sized.Parrot where

open import Data.Product
open import Data.String.Base

open import SizedIO.IOObject

open import SizedIO.Base
open import SizedIO.Console hiding (main)
open import SizedIO.ConsoleObject

open import NativeIO

open import Sized.SimpleCell hiding (program; main)

open import Size

record Wrap A : Set where
  constructor wrap
  field unwrap : A

parrotI = cellJ (Wrap String)

ParrotC : (i : Size) → Set
ParrotC i = ConsoleObject i parrotI

-- but reusing cellC from SimpleCell, as interface is ident!

-- class Parrot implements Cell {
--   Cell cell;
--   Parrot (Cell c) { cell = c; }
--   public String get() {
--     return "(" + cell.get() + ") is what parrot got";
--   }
--   public void put (String s) {
--     cell.put("parrot puts (" + s + ")");
--   }
-- }

-- parrotP is constructor for the consoleObject for interface (cellI String)

parrotP : ∀{i} (c : CellC i) → ParrotC i
(method (parrotP c) get) =
  method c get >>= λ { (s , c') →
  return (wrap ("(" ++ s ++ ") is what parrot got") ,  parrotP c' )  }
(method (parrotP c) (put (wrap s))) =
  method c (put ("parrot puts (" ++ s ++ ")")) >>= λ { (_ , c') →
  return (_ ,  parrotP c') }

--   public static void main (String[] args) {
--     Parrot c = new Parrot(new SimpleCell("Start"));
--     System.out.println(c.get());
--     c.put(args[1]);
--     System.out.println(c.get());
--   }
-- }

program : String → IOConsole ∞ Unit
program arg =
  let c₀ = parrotP (cellP "Start") in
  method c₀ get               >>= λ{ (wrap s   , c₁) →
  exec1 (putStrLn s)            >>
  method c₁ (put (wrap arg))  >>= λ{ (_        , c₂) →
  method c₂ get               >>= λ{ (wrap s'  , c₃) →
  exec1 (putStrLn s')           }}}

main : NativeIO Unit
main = translateIOConsole (program "hello")

-- -}


-- Andreas, 2018-05-11, issue #3049 reported by Ulf
-- Positivity checker too optimistic about polarity of arguments
-- beyond the formal function arity.

-- Backwards-compatible version of the test case.

-- {-# OPTIONS -v tc.pos.args:100 #-}

module Issue3049 where

data Bool : Set where
  true false : Bool

T : Bool → Set₁
T true  = Set → Set
T false = Set

bad : ∀ b → T b
bad true   = λ A → A → A   -- negative A
bad false  = Bool

F : Bool → ∀ b → T b
F true  b       = bad b  -- is not (can't be) eta-expanded
F false true    = λ A → A
F false false   = Bool

-- Should fail positivity check:

data D : Set where
  nop : (b : Bool) → F b true D → D

data ⊥ : Set where

d : D
d = nop true (λ x → x)

!d : D → ⊥
!d (nop true  f) = !d (f d)
!d (nop false x) = !d x

loop : ⊥
loop = !d d


{-# OPTIONS --without-K #-}

module Data.Word8.Primitive where

open import Agda.Builtin.Bool using (Bool)
open import Agda.Builtin.Nat using (Nat)

{-# FOREIGN GHC import qualified Data.Word #-}
{-# FOREIGN GHC import qualified Data.Bits #-}
postulate
  Word8 : Set
  _==_ : Word8 → Word8 → Bool
  _/=_ : Word8 → Word8 → Bool
  _xor_ : Word8 → Word8 → Word8
  _and_ : Word8 → Word8 → Word8
  _or_ : Word8 → Word8 → Word8
{-# COMPILE GHC Word8 = type Data.Word.Word8 #-}
{-# COMPILE GHC _==_ = (Prelude.==) #-}
{-# COMPILE GHC _/=_ = (Prelude./=) #-}
{-# COMPILE GHC _xor_ = (Data.Bits.xor) #-}
{-# COMPILE GHC _and_ = (Data.Bits..&.) #-}
{-# COMPILE GHC _or_ = (Data.Bits..|.) #-}

postulate
  primWord8fromNat : Nat → Word8
  primWord8toNat : Word8 → Nat
{-# COMPILE GHC primWord8fromNat = (\n -> Prelude.fromIntegral n) #-}
{-# COMPILE GHC primWord8toNat = (\w -> Prelude.fromIntegral w) #-}