module CoercionExpr.CatchUpBack where
open import Data.Nat
open import Data.Unit using (β€; tt)
open import Data.Bool using (true; false) renaming (Bool to πΉ)
open import Data.List hiding ([_])
open import Data.Product renaming (_,_ to β¨_,_β©)
open import Data.Sum using (_β_)
open import Data.Maybe
open import Relation.Nullary using (Β¬_; Dec; yes; no)
open import Relation.Binary.PropositionalEquality using (_β‘_; refl)
open import Function using (case_of_)
open import Common.Utils
open import Common.SecurityLabels
open import Common.BlameLabels
open import CoercionExpr.CoercionExpr
open import CoercionExpr.Precision
data InSync : β {gβ gββ² gβ gββ²} (cΜ
β : CExpr gβ β gβ) (cΜ
β : CExpr gββ² β gββ²) β Set where
v-v : β {gβ gββ² gβ gββ²} {cΜ
β : CExpr gβ β gβ} {cΜ
β : CExpr gββ² β gββ²}
β CVal cΜ
β
β β’ cΜ
β β cΜ
β
β InSync cΜ
β cΜ
β
v-β₯ : β {gβ gββ² gβ gββ²} {cΜ
β : CExpr gβ β gβ} {p}
β β’ cΜ
β β β₯ gββ² gββ² p
β InSync cΜ
β (β₯ gββ² gββ² p)
catchup-back : β {β ββ² g gβ²} (cΜ
: CExpr l β β g) (cΜ
ββ² : CExpr l ββ² β gβ²)
β CVal cΜ
β β’ cΜ
β cΜ
ββ²
β β[ cΜ
ββ² ] (cΜ
ββ² ββ cΜ
ββ²) Γ (InSync cΜ
cΜ
ββ²)
catchup-back (id (l β)) (id (l ββ²)) id (β-id lβl) = β¨ _ , _ β , v-v id (β-id lβl) β©
catchup-back (id (l β)) (cΜ
β² β¨Ύ id ββ²) id (β-castr x lβl lβl)
with catchup-back _ _ id x
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-v v y β© =
β¨ cΜ
ββ² , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (cΜ
ββ² β¨Ύ id (l β) βββ¨ id v β© cΜ
ββ² β) , v-v v y β©
... | β¨ β₯ _ _ p , cΜ
β²β β₯ , v-β₯ y β© =
β¨ β₯ _ _ p , β -trans (plug-cong cΜ
β²β β₯) (β₯ _ _ p β¨Ύ id (l β) βββ¨ ΞΎ-β₯ β© β₯ _ _ p β) ,
v-β₯ y β©
catchup-back (id (l β)) (β₯ (l _) _ p) id (β-β₯ lβl lβl) =
β¨ _ , _ β , v-β₯ (β-β₯ lβl lβl) β©
catchup-back (cΜ
β¨Ύ β !) (cΜ
β² β¨Ύ id (l β)) (inj v) (β-cast cΜ
βcΜ
β² lβl ββ)
with catchup-back _ _ v cΜ
βcΜ
β²
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-v v x β© =
β¨ cΜ
ββ² , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (cΜ
ββ² β¨Ύ id (l β) βββ¨ id v β© cΜ
ββ² β) , v-v v (β-castl x lβl ββ) β©
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-β₯ x β©
with precββ _ _ cΜ
βcΜ
β²
... | β¨ ββββ² , _ β© =
β¨ β₯ _ _ _ , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (_ βββ¨ ΞΎ-β₯ β© _ β) , v-β₯ (β-β₯ ββββ² ββ) β©
catchup-back (cΜ
β¨Ύ β !) (cΜ
β² β¨Ύ β !) (inj v) (β-cast cΜ
βcΜ
β² lβl ββ)
with catchup-back _ _ v cΜ
βcΜ
β²
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-v v x β© =
β¨ cΜ
ββ² β¨Ύ β ! , plug-cong cΜ
β²β cΜ
ββ² , v-v (inj v) (β-cast x lβl ββ) β©
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-β₯ x β©
with precββ _ _ cΜ
βcΜ
β²
... | β¨ ββββ² , _ β© =
β¨ β₯ _ _ _ , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (_ βββ¨ ΞΎ-β₯ β© _ β) , v-β₯ (β-β₯ ββββ² ββ) β©
catchup-back (cΜ
β¨Ύ β !) (cΜ
β² β¨Ύ β) (inj v) (β-cast cΜ
βcΜ
β² lβl ββ)
with catchup-back _ _ v cΜ
βcΜ
β²
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-v v x β© =
β¨ cΜ
ββ² β¨Ύ β , plug-cong cΜ
β²β cΜ
ββ² , v-v (up v) (β-cast x lβl ββ) β©
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-β₯ x β©
with precββ _ _ cΜ
βcΜ
β²
... | β¨ ββββ² , _ β© =
β¨ β₯ _ _ _ , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (_ βββ¨ ΞΎ-β₯ β© _ β) , v-β₯ (β-β₯ ββββ² ββ) β©
catchup-back (cΜ
β¨Ύ β !) cΜ
ββ² (inj v) (β-castl x lβl ββ)
with catchup-back cΜ
cΜ
ββ² v x
... | β¨ cΜ
ββ² , cΜ
ββ²β cΜ
ββ² , v-v v y β© =
β¨ cΜ
ββ² , cΜ
ββ²β cΜ
ββ² , v-v v (β-castl y lβl ββ) β©
... | β¨ cΜ
ββ² , cΜ
ββ²β β₯ , v-β₯ y β© =
β¨ β₯ _ _ _ , cΜ
ββ²β β₯ , v-β₯ (β-castl y lβl ββ) β©
catchup-back (cΜ
β¨Ύ β !) (cΜ
β² β¨Ύ id gβ²) (inj v) (β-castr x ββ ββ)
with catchup-back (cΜ
β¨Ύ β !) cΜ
β² (inj v) x
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-v v y β© =
β¨ cΜ
ββ² , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (cΜ
ββ² β¨Ύ id gβ² βββ¨ id v β© cΜ
ββ² β) , v-v v y β©
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-β₯ y β©
with precββ _ _ y
... | β¨ ββββ² , _ β© =
β¨ β₯ _ _ _ , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (_ βββ¨ ΞΎ-β₯ β© _ β) , v-β₯ (β-β₯ ββββ² ββ) β©
catchup-back (cΜ
β¨Ύ β !) (cΜ
β² β¨Ύ β) (inj v) (β-castr x ββ ββ)
with catchup-back (cΜ
β¨Ύ β !) cΜ
β² (inj v) x
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-v v y β© =
β¨ cΜ
ββ² β¨Ύ β , plug-cong cΜ
β²β cΜ
ββ² , v-v (up v) (β-castr y ββ ββ) β©
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-β₯ y β©
with precββ _ _ y
... | β¨ ββββ² , _ β© =
β¨ β₯ _ _ _ , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (_ βββ¨ ΞΎ-β₯ β© _ β) , v-β₯ (β-β₯ ββββ² ββ) β©
catchup-back (cΜ
β¨Ύ β !) (cΜ
β² β¨Ύ ββ² !) (inj v) (β-castr x ββ ββ)
with catchup-back (cΜ
β¨Ύ β !) cΜ
β² (inj v) x
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-v v y β© =
β¨ cΜ
ββ² β¨Ύ ββ² ! , plug-cong cΜ
β²β cΜ
ββ² , v-v (inj v) (β-castr y ββ ββ) β©
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-β₯ y β©
with precββ _ _ y
... | β¨ ββββ² , _ β© =
β¨ β₯ _ _ _ , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (_ βββ¨ ΞΎ-β₯ β© _ β) , v-β₯ (β-β₯ ββββ² ββ) β©
catchup-back (cΜ
β¨Ύ β !) (cΜ
β² β¨Ύ low ?? p) (inj v) (β-castr x ββ ββ)
with catchup-back (cΜ
β¨Ύ β !) cΜ
β² (inj v) x
... | β¨ cΜ
ββ² β¨Ύ low ! , cΜ
β²β cΜ
ββ² , v-v (inj vβ²) y β© =
β¨ cΜ
ββ² , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (cΜ
ββ² β¨Ύ (low !) β¨Ύ (low ?? p) βββ¨ ?-id vβ² β© cΜ
ββ² β) ,
v-v vβ² (prec-inj-left _ _ (inj v) vβ² y) β©
... | β¨ cΜ
ββ² β¨Ύ high ! , cΜ
β²β cΜ
ββ² , v-v (inj vβ²) y β© =
let β¨ ββββ² , _ β© = precββ _ _ y in
β¨ β₯ _ _ p , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (cΜ
ββ² β¨Ύ (high !) β¨Ύ (low ?? p) βββ¨ ?-β₯ vβ² β© β₯ _ (l low) p β) ,
v-β₯ (β-β₯ ββββ² ββ) β©
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-β₯ y β©
with precββ _ _ y
... | β¨ ββββ² , _ β© =
β¨ β₯ _ _ _ , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (_ βββ¨ ΞΎ-β₯ β© _ β) , v-β₯ (β-β₯ ββββ² ββ) β©
catchup-back (cΜ
β¨Ύ β !) (cΜ
β² β¨Ύ high ?? p) (inj v) (β-castr x ββ ββ)
with catchup-back (cΜ
β¨Ύ β !) cΜ
β² (inj v) x
... | β¨ cΜ
ββ² β¨Ύ low ! , cΜ
β²β cΜ
ββ² , v-v (inj vβ²) y β© =
β¨ cΜ
ββ² β¨Ύ β , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (cΜ
ββ² β¨Ύ (low !) β¨Ύ (high ?? p) βββ¨ ?-β vβ² β© cΜ
ββ² β¨Ύ β β) ,
v-v (up vβ²) (β-castr (prec-inj-left _ _ (inj v) vβ² y) ββ ββ) β©
... | β¨ cΜ
ββ² β¨Ύ high ! , cΜ
β²β cΜ
ββ² , v-v (inj vβ²) y β© =
β¨ cΜ
ββ² , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (cΜ
ββ² β¨Ύ (high !) β¨Ύ (high ?? p) βββ¨ ?-id vβ² β© cΜ
ββ² β) ,
v-v vβ² (prec-inj-left _ _ (inj v) vβ² y) β©
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-β₯ y β©
with precββ _ _ y
... | β¨ ββββ² , _ β© =
β¨ β₯ _ _ _ , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (_ βββ¨ ΞΎ-β₯ β© _ β) , v-β₯ (β-β₯ ββββ² ββ) β©
catchup-back (cΜ
β¨Ύ β !) (β₯ (l _) _ p) (inj v) (β-β₯ lβl ββ) = β¨ _ , _ β , v-β₯ (β-β₯ lβl ββ) β©
catchup-back (cΜ
β¨Ύ β) (cΜ
β² β¨Ύ β) (up v) (β-cast x lβl lβl)
with catchup-back cΜ
cΜ
β² v x
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-v v y β© =
β¨ cΜ
ββ² β¨Ύ β , plug-cong cΜ
β²β cΜ
ββ² , v-v (up v) (β-cast y lβl lβl) β©
... | β¨ β₯ _ _ p , cΜ
β²β β₯ , v-β₯ y β© =
let β¨ ββββ² , _ β© = precββ _ _ x in
β¨ β₯ _ _ p , β -trans (plug-cong cΜ
β²β β₯) (β₯ _ _ p β¨Ύ β βββ¨ ΞΎ-β₯ β© β₯ _ _ p β) ,
v-β₯ (β-β₯ ββββ² lβl) β©
catchup-back (cΜ
β¨Ύ β) (cΜ
β² β¨Ύ id _) (up v) (β-cast x lβl ())
catchup-back (cΜ
β¨Ύ β) cΜ
ββ² (up v) (β-castl x lβl ())
catchup-back (cΜ
β¨Ύ β) (cΜ
β² β¨Ύ id (l high)) (up v) (β-castr x lβl lβl)
with catchup-back (cΜ
β¨Ύ β) cΜ
β² (up v) x
... | β¨ cΜ
ββ² , cΜ
β²β cΜ
ββ² , v-v v y β© =
β¨ cΜ
ββ² , β -trans (plug-cong cΜ
β²β cΜ
ββ²) (cΜ
ββ² β¨Ύ id (l high) βββ¨ id v β© cΜ
ββ² β) , v-v v y β©
... | β¨ β₯ _ _ p , cΜ
β²β β₯ , v-β₯ y β© =
β¨ β₯ _ _ p , β -trans (plug-cong cΜ
β²β β₯) (β₯ _ _ p β¨Ύ id (l high) βββ¨ ΞΎ-β₯ β© β₯ _ _ p β) ,
v-β₯ y β©
catchup-back (cΜ
β¨Ύ β) (β₯ (l _) _ p) (up v) (β-β₯ lβl lβl) =
β¨ β₯ _ _ p , _ β , v-β₯ (β-β₯ lβl lβl) β©
catchup-back-right : β {g ββ² gβ²} (cΜ
ββ² : CExpr l ββ² β gβ²)
β β’ id g β cΜ
ββ²
β β[ cΜ
ββ² ] (cΜ
ββ² ββ cΜ
ββ²) Γ (InSync (id g) cΜ
ββ²)
catchup-back-right {l β} cΜ
ββ² prec = catchup-back (id (l β)) cΜ
ββ² id prec
catchup-back-right {β} (id (l ββ²)) (β-id ββ) =
β¨ _ , _ β , v-v id (β-id ββ) β©
catchup-back-right {β} (cΜ
β² β¨Ύ cβ²) (β-castr idββcΜ
β² ββ ββ)
with catchup-back-right _ idββcΜ
β²
... | β¨ β₯ _ _ p , cΜ
β²β β₯ , v-β₯ (β-β₯ ββ ββ) β© =
β¨ β₯ _ _ p , β -trans (plug-cong cΜ
β²β β₯) (_ βββ¨ ΞΎ-β₯ β© _ β) , v-β₯ (β-β₯ ββ ββ) β©
... | β¨ cΜ
β³ , cΜ
β²β cΜ
β³ , v-v πβ³ idββcΜ
β³ β© with cβ²
... | id gβ² =
β¨ cΜ
β³ , β -trans (plug-cong cΜ
β²β cΜ
β³) (cΜ
β³ β¨Ύ id gβ² βββ¨ id πβ³ β© cΜ
β³ β) , v-v πβ³ idββcΜ
β³ β©
... | β =
β¨ cΜ
β³ β¨Ύ β , plug-cong cΜ
β²β cΜ
β³ , v-v (up πβ³) (β-castr idββcΜ
β³ ββ ββ) β©
... | ββ² ! =
β¨ cΜ
β³ β¨Ύ ββ² ! , plug-cong cΜ
β²β cΜ
β³ , v-v (inj πβ³) (β-castr idββcΜ
β³ ββ ββ) β©
... | ββ² ?? p with πβ³ | ββ²
... | (inj (id {l low})) | low =
β¨ id (l low) , β -trans (plug-cong cΜ
β²β cΜ
β³) (_ βββ¨ ?-id id β© _ β) ,
v-v id (β-id ββ) β©
... | (inj (id {l high})) | low =
β¨ β₯ _ _ p , β -trans (plug-cong cΜ
β²β cΜ
β³) (_ βββ¨ ?-β₯ id β© _ β) ,
v-β₯ (β-β₯ ββ ββ) β©
... | (inj (id {l low})) | high =
β¨ id (l low) β¨Ύ β , β -trans (plug-cong cΜ
β²β cΜ
β³) (_ βββ¨ ?-β id β© _ β) ,
v-v (up id) (β-castr (β-id ββ) ββ ββ) β©
... | (inj (id {l high})) | high =
β¨ id (l high) , β -trans (plug-cong cΜ
β²β cΜ
β³) (_ βββ¨ ?-id id β© _ β) ,
v-v id (β-id ββ) β©
... | (inj (up id)) | low =
β¨ β₯ _ _ p , β -trans (plug-cong cΜ
β²β cΜ
β³) (_ βββ¨ ?-β₯ (up id) β© _ β) ,
v-β₯ (β-β₯ ββ ββ) β©
... | (inj (up id)) | high =
β¨ id (l low) β¨Ύ β , β -trans (plug-cong cΜ
β²β cΜ
β³) (_ βββ¨ ?-id (up id) β© _ β) ,
v-v (up id) (β-castr (β-id ββ) ββ ββ) β©
catchup-back-right {β} (β₯ (l _) _ p) (β-β₯ ββ ββ) =
β¨ β₯ _ _ p , _ β , v-β₯ (β-β₯ ββ ββ) β©