module Semantics.Equivalence where
open import Syntax
open import Semantics.BigStep
open import Semantics.SmallStep
open import Semantics.SmallStep.EvalCtxt
open ⟶-Reasoning
open import Infinite hiding (_⇓_; return)
open import Totality
open import Data.Star hiding (return)
open import Data.Product
open import Data.Nat
open import Relation.Nullary
open import Category.Monad
open RawMonad ¬¬-Monad hiding (_>>_)
open import Data.Function
record Big⇒Small : Set where
field
⇓ : ∀ {t} {e : Expr t} {i v} → e ⇓[ i ] v → e ˢ ⟶⋆[ i ] done v
⇑ : ∀ {t} {e : Expr t} {i} → e ⇑[ i ] → e ˢ ⟶∞[ i ]
record Small⇒Big : Set where
field
⟶⋆ : ∀ {t} {e : Exprˢ t} {i v} → e ⟶⋆[ i ] done v → e ˢ⁻¹ ⇓[ i ] v
⟶∞ : ∀ {t} (e : Exprˢ t) i → e ⟶∞[ i ] → ¬ ¬ e ˢ⁻¹ ⇑[ i ]
big⇒small⇓ : ∀ {t} {e : Expr t} {i v} →
e ⇓[ i ] v → e ˢ ⟶⋆[ i ] done v
big⇒small⇓ (Val {v = v}) = begin
run ⌜ v ⌝ ⟶⟨ Red Val ⟩
done v ∎
big⇒small⇓ (Loop {x = x} {v} ⇓) = begin
run (loop (x ˢ)) ⟶⟨ Red Loop ⟩
run (x ˢ >> run (loop (x ˢ))) ⟶⋆⟨ big⇒small⇓ ⇓ ⟩
done v ∎
big⇒small⇓ (Add₁ {x = x} {y} {m} {n} x⇓ y⇓) = begin
run (x ˢ ⊕ y ˢ) ⟶⋆⟨ lift⟶⋆ (• •⊕ y ˢ) (big⇒small⇓ x⇓) ⟩
run (done (nat m) ⊕ y ˢ) ⟶⋆⟨ lift⟶⋆ (nat m ⊕• •) (big⇒small⇓ y⇓) ⟩
run (done (nat m) ⊕ done (nat n)) ⟶⟨ Red Add₁ ⟩
done (nat (m + n)) ∎
big⇒small⇓ (Add₂ {x = x} {y} x↯) = begin
run (x ˢ ⊕ y ˢ) ⟶⋆⟨ lift⟶⋆ (• •⊕ y ˢ) (big⇒small⇓ x↯) ⟩
run (done throw ⊕ y ˢ) ⟶⟨ Red Add₂ ⟩
done throw ∎
big⇒small⇓ (Add₃ {x = x} {y} {m} x⇓ y↯) = begin
run (x ˢ ⊕ y ˢ) ⟶⋆⟨ lift⟶⋆ (• •⊕ y ˢ) (big⇒small⇓ x⇓) ⟩
run (done (nat m) ⊕ y ˢ) ⟶⋆⟨ lift⟶⋆ (nat m ⊕• •) (big⇒small⇓ y↯) ⟩
run (done (nat m) ⊕ done throw) ⟶⟨ Red Add₃ ⟩
done throw ∎
big⇒small⇓ (Seqn₁ {x = x} {y} {m} {v} x⇓ y⇒) = begin
run (x ˢ >> y ˢ) ⟶⋆⟨ lift⟶⋆ (• •>> y ˢ) (big⇒small⇓ x⇓) ⟩
run (done (nat m) >> y ˢ) ⟶⟨ Red Seqn₁ ⟩
y ˢ ⟶⋆⟨ big⇒small⇓ y⇒ ⟩
done v ∎
big⇒small⇓ (Seqn₂ {x = x} {y} x↯) = begin
run (x ˢ >> y ˢ) ⟶⋆⟨ lift⟶⋆ (• •>> y ˢ) (big⇒small⇓ x↯) ⟩
run (done throw >> y ˢ) ⟶⟨ Red Seqn₂ ⟩
done throw ∎
big⇒small⇓ (Catch₁ {x = x} {y} {m} x⇓) = begin
run (x ˢ catch y ˢ) ⟶⋆⟨ lift⟶⋆ (• •catch y ˢ) (big⇒small⇓ x⇓) ⟩
run (done (nat m) catch y ˢ) ⟶⟨ Red Catch₁ ⟩
done (nat m) ∎
big⇒small⇓ (Catch₂ {x = x} {y} {v} x↯ y⇒) = begin
run (x ˢ catch y ˢ) ⟶⋆⟨ lift⟶⋆ (• •catch y ˢ) (big⇒small⇓ x↯) ⟩
run (done throw catch y ˢ) ⟶⋆⟨ lift⟶⋆ (handler• •) (big⇒small⇓ y⇒) ⟩
run (done throw catch done v) ⟶⟨ Red Catch₂ ⟩
done v ∎
big⇒small⇓ (Int {x = x}) = begin
x ˢ ⟶⟨ Red (Int (x ˢ-interruptible)) ⟩
done throw ∎
big⇒small⇓ (Block {x = x} {v} x⇒) = begin
run (block (x ˢ)) ⟶⋆⟨ lift⟶⋆ (block• •) (big⇒small⇓ x⇒) ⟩
run (block (done v)) ⟶⟨ Red Block ⟩
done v ∎
big⇒small⇓ (Unblock {x = x} {v} x⇒) = begin
run (unblock (x ˢ)) ⟶⋆⟨ lift⟶⋆ (unblock• •) (big⇒small⇓ x⇒) ⟩
run (unblock (done v)) ⟶⟨ Red Unblock ⟩
done v ∎
data Loops t i : Exprˢ t → Set where
⇑:_ : ∀ {e} (⇑ : e ⇑[ i ]) → Loops t i (e ˢ)
lift⟶∞ʳ : ∀ {t i j x g}
(E : EvalCtxt t i j) →
Infiniteʳ Step (Loops t) g i x →
Infiniteʳ Step (Loops t) g j (E [ x ])
lift⟶∞ʳ E = map∞ʳ (λ x → E [ x ]) (lift⟶ E)
big⇒small⇑ʳ : ∀ {t g} → Stepper Step (Loops t) g
big⇒small⇑ʳ (⇑: Loop ⇑) = Red Loop ◅∞ rec (⇑: ⇑)
big⇒small⇑ʳ (⇑: Add₁ x⇑) = lift⟶∞ʳ (• •⊕ _) (big⇒small⇑ʳ (⇑: x⇑))
big⇒small⇑ʳ (⇑: Add₂ x↡ y⇑) = lift⟶⋆ (• •⊕ _) (big⇒small⇓ (proj₂ x↡))
◅◅∞ʳ
lift⟶∞ʳ (nat proj₁ x↡ ⊕• •) (big⇒small⇑ʳ (⇑: y⇑))
big⇒small⇑ʳ (⇑: Seqn₁ x⇑) = lift⟶∞ʳ (• •>> _) (big⇒small⇑ʳ (⇑: x⇑))
big⇒small⇑ʳ (⇑: Seqn₂ x↡ y⇑) = lift⟶⋆ (• •>> _) (big⇒small⇓ (proj₂ x↡))
◅◅∞ʳ
Red Seqn₁
◅∞
big⇒small⇑ʳ (⇑: y⇑)
big⇒small⇑ʳ (⇑: Catch₁ x⇑) = lift⟶∞ʳ (• •catch _) (big⇒small⇑ʳ (⇑: x⇑))
big⇒small⇑ʳ (⇑: Catch₂ x↯ y⇑) = lift⟶⋆ (• •catch _) (big⇒small⇓ x↯)
◅◅∞ʳ
lift⟶∞ʳ (handler• •) (big⇒small⇑ʳ (⇑: y⇑))
big⇒small⇑ʳ (⇑: Block x⇑) = lift⟶∞ʳ (block• •) (big⇒small⇑ʳ (⇑: x⇑))
big⇒small⇑ʳ (⇑: Unblock x⇑) = lift⟶∞ʳ (unblock• •) (big⇒small⇑ʳ (⇑: x⇑))
big⇒small⇑ : ∀ {t} {e : Expr t} {i} → e ⇑[ i ] → e ˢ ⟶∞[ i ]
big⇒small⇑ = unfold big⇒small⇑ʳ ∘ ⇑:_
big⇒small : Big⇒Small
big⇒small = record { ⇓ = big⇒small⇓; ⇑ = big⇒small⇑ }
map⇓ : ∀ {t} {x₁ x₂ : Exprˢ t} {i j v} (E : EvalCtxt t i j) →
(∀ {v} → x₁ ˢ⁻¹ ⇓[ i ] v → x₂ ˢ⁻¹ ⇓[ i ] v) →
E [ x₁ ] ˢ⁻¹ ⇓[ j ] v → E [ x₂ ] ˢ⁻¹ ⇓[ j ] v
map⇓ • f ⇓ = f ⇓
map⇓ (E •⊕ y) f (Add₁ x↡ y↡) = Add₁ (map⇓ E f x↡) y↡
map⇓ (E •⊕ y) f (Add₂ x↯) = Add₂ (map⇓ E f x↯)
map⇓ (E •⊕ y) f (Add₃ x↡ y↯) = Add₃ (map⇓ E f x↡) y↯
map⇓ (E •⊕ y) f Int = Int
map⇓ (E •>> y) f (Seqn₁ x↡ y⇓) = Seqn₁ (map⇓ E f x↡) y⇓
map⇓ (E •>> y) f (Seqn₂ x↯) = Seqn₂ (map⇓ E f x↯)
map⇓ (E •>> y) f Int = Int
map⇓ (E •catch y) f (Catch₁ x↡) = Catch₁ (map⇓ E f x↡)
map⇓ (E •catch y) f (Catch₂ x↯ y⇓) = Catch₂ (map⇓ E f x↯) y⇓
map⇓ (E •catch y) f Int = Int
map⇓ (nat m ⊕• E) f (Add₁ x↡ y↡) = Add₁ x↡ (map⇓ E f y↡)
map⇓ (nat m ⊕• E) f (Add₂ x↯) = Add₂ x↯
map⇓ (nat m ⊕• E) f (Add₃ x↡ y↯) = Add₃ x↡ (map⇓ E f y↯)
map⇓ (nat m ⊕• E) f Int = Int
map⇓ (handler• E) f (Catch₁ ())
map⇓ (handler• E) f (Catch₂ x↯ y⇓) = Catch₂ x↯ (map⇓ E f y⇓)
map⇓ (handler• E) f Int = Int
map⇓ (block• E) f (Block x⇓) = Block (map⇓ E f x⇓)
map⇓ (block• E) f Int = Int
map⇓ (unblock• E) f (Unblock x⇓) = Unblock (map⇓ E f x⇓)
map⇓ (unblock• E) f Int = Int
map⇑ : ∀ {t} {x₁ x₂ : Exprˢ t} {i j} (E : EvalCtxt t i j) →
(∀ {v} → x₁ ˢ⁻¹ ⇓[ i ] v → x₂ ˢ⁻¹ ⇓[ i ] v) →
(x₁ ˢ⁻¹ ⇑[ i ] → x₂ ˢ⁻¹ ⇑[ i ]) →
E [ x₁ ] ˢ⁻¹ ⇑[ j ] → E [ x₂ ] ˢ⁻¹ ⇑[ j ]
map⇑ • f g ⇑ = g ⇑
map⇑ (E •⊕ y) f g (Add₁ x⇑) = Add₁ (map⇑ E f g x⇑)
map⇑ (E •⊕ y) f g (Add₂ (_ , x↡) y⇑) = Add₂ (_ , map⇓ E f x↡) y⇑
map⇑ (E •>> y) f g (Seqn₁ x⇑) = Seqn₁ (map⇑ E f g x⇑)
map⇑ (E •>> y) f g (Seqn₂ (_ , x↡) y⇑) = Seqn₂ (_ , map⇓ E f x↡) y⇑
map⇑ (E •catch y) f g (Catch₁ x⇑) = Catch₁ (map⇑ E f g x⇑)
map⇑ (E •catch y) f g (Catch₂ x↯ y⇑) = Catch₂ (map⇓ E f x↯) y⇑
map⇑ (nat m ⊕• E) f g (Add₁ ())
map⇑ (nat m ⊕• E) f g (Add₂ x↡ y⇑) = Add₂ x↡ (map⇑ E f g y⇑)
map⇑ (handler• E) f g (Catch₁ ())
map⇑ (handler• E) f g (Catch₂ x↯ y⇑) = Catch₂ x↯ (map⇑ E f g y⇑)
map⇑ (block• E) f g (Block x⇑) = Block (map⇑ E f g x⇑)
map⇑ (unblock• E) f g (Unblock x⇑) = Unblock (map⇑ E f g x⇑)
small⇒big⟶ʳ⇓ : ∀ {t i} {e₁ e₂ : Exprˢ t} {v} →
e₁ ⟶ʳ[ i ] e₂ → e₂ ˢ⁻¹ ⇓[ i ] v → e₁ ˢ⁻¹ ⇓[ i ] v
small⇒big⟶ʳ⇓ Val ⇓ = ⇓
small⇒big⟶ʳ⇓ Loop (Seqn₁ x↡ y⇓) = y⇓
small⇒big⟶ʳ⇓ Loop (Seqn₂ x↯) = Loop (Seqn₂ x↯)
small⇒big⟶ʳ⇓ Loop Int = Int
small⇒big⟶ʳ⇓ Add₁ Val = Add₁ Val Val
small⇒big⟶ʳ⇓ Add₁ Int = Int
small⇒big⟶ʳ⇓ Add₂ Val = Add₂ Val
small⇒big⟶ʳ⇓ Add₂ Int = Int
small⇒big⟶ʳ⇓ Add₃ Val = Add₃ Val Val
small⇒big⟶ʳ⇓ Add₃ Int = Int
small⇒big⟶ʳ⇓ Seqn₁ ⇓ = Seqn₁ Val ⇓
small⇒big⟶ʳ⇓ Seqn₂ Val = Seqn₂ Val
small⇒big⟶ʳ⇓ Seqn₂ Int = Int
small⇒big⟶ʳ⇓ Catch₁ Val = Catch₁ Val
small⇒big⟶ʳ⇓ Catch₁ Int = Int
small⇒big⟶ʳ⇓ Catch₂ Val = Catch₂ Val Val
small⇒big⟶ʳ⇓ Catch₂ Int = Int
small⇒big⟶ʳ⇓ Block Val = Block Val
small⇒big⟶ʳ⇓ Block Int = Int
small⇒big⟶ʳ⇓ Unblock Val = Unblock Val
small⇒big⟶ʳ⇓ Unblock Int = Int
small⇒big⟶ʳ⇓ (Int int) Val = Int
small⇒big⟶ʳ⇓ (Int int) Int = Int
small⇒big⟶ʳ⇑ : ∀ {t} {e₁ e₂ : Exprˢ t} {i} →
e₁ ⟶ʳ[ i ] e₂ → e₂ ˢ⁻¹ ⇑[ i ] → e₁ ˢ⁻¹ ⇑[ i ]
small⇒big⟶ʳ⇑ Val ()
small⇒big⟶ʳ⇑ Loop ⇑ = Loop ⇑
small⇒big⟶ʳ⇑ Add₁ ()
small⇒big⟶ʳ⇑ Add₂ ()
small⇒big⟶ʳ⇑ Add₃ ()
small⇒big⟶ʳ⇑ Seqn₁ ⇑ = Seqn₂ (_ , Val) ⇑
small⇒big⟶ʳ⇑ Seqn₂ ()
small⇒big⟶ʳ⇑ Catch₁ ()
small⇒big⟶ʳ⇑ Catch₂ ()
small⇒big⟶ʳ⇑ Block ()
small⇒big⟶ʳ⇑ Unblock ()
small⇒big⟶ʳ⇑ (Int int) ()
small⇒big⟶⋆ : ∀ {t} {e : Exprˢ t} {i v} →
e ⟶⋆[ i ] done v → e ˢ⁻¹ ⇓[ i ] v
small⇒big⟶⋆ ε = Val
small⇒big⟶⋆ (⟶ ◅ ⟶⋆) with ⟶⇒⟶E ⟶
small⇒big⟶⋆ (⟶ ◅ ⟶⋆) | Red E ⟶ʳ =
map⇓ E (small⇒big⟶ʳ⇓ ⟶ʳ) (small⇒big⟶⋆ ⟶⋆)
open import Semantics.Equivalence.Lemmas
small⇒big⟶∞ : ∀ {t} (e : Exprˢ t) i →
e ⟶∞[ i ] → ¬ ¬ e ˢ⁻¹ ⇑[ i ]
small⇒big⟶∞ (done v) i ⟶∞ = const (done↛∞ ⟶∞)
small⇒big⟶∞ (run ⌜ v ⌝) i (Red Val ◅∞ ⟶∞) = const (done↛∞ ⟶∞)
small⇒big⟶∞ (run ⌜ v ⌝) .U (Red (Int int) ◅∞ ⟶∞) = const (done↛∞ ⟶∞)
small⇒big⟶∞ (run (loop x)) i ⟶∞ = helper =<< excluded-middle
where
helper : Dec (∃ λ z → (x ⟶⋆[ i ] z) × Loop.Pred i z) → _
helper (yes (._ , x⟶⋆n , Loop.• n)) = return (loop-⇑ (n , small⇒big⟶⋆ x⟶⋆n))
helper (no x↛⋆n) = Loop <$> (Seqn₁ <$> small⇒big⟶∞ x i x⟶∞)
where x⟶∞ = ⋆∞⇒∞ (Loop.lemma ⟶∞) x↛⋆n
small⇒big⟶∞ (run (x ⊕ y)) i ⟶∞ = helper =<< excluded-middle
where
helper : Dec (∃ λ z → (x ⟶⋆[ i ] z) × Add.Pred y i z) → _
helper (yes (._ , x⟶⋆n , Add.• n y⟶∞)) = Add₂ (n , small⇒big⟶⋆ x⟶⋆n)
<$> small⇒big⟶∞ y i y⟶∞
helper (no x↛⋆n) = Add₁ <$> small⇒big⟶∞ x i x⟶∞
where x⟶∞ = ⋆∞⇒∞ (Add.lemma ⟶∞) x↛⋆n
small⇒big⟶∞ (run (x >> y)) i ⟶∞ = helper =<< excluded-middle
where
helper : Dec (∃ λ z → (x ⟶⋆[ i ] z) × Seqn.Pred y i z) → _
helper (yes (._ , x⟶⋆n , Seqn.• n y⟶∞)) = Seqn₂ (n , small⇒big⟶⋆ x⟶⋆n)
<$> small⇒big⟶∞ y i y⟶∞
helper (no x↛⋆n) = Seqn₁ <$> small⇒big⟶∞ x i x⟶∞
where x⟶∞ = ⋆∞⇒∞ (Seqn.lemma ⟶∞) x↛⋆n
small⇒big⟶∞ (run (x catch y)) i ⟶∞ = helper =<< excluded-middle
where
helper : Dec (∃ λ z → (x ⟶⋆[ i ] z) × Catch.Pred y i z) → _
helper (yes (._ , x⟶⋆↯ , Catch.• y⟶∞)) = Catch₂ (small⇒big⟶⋆ x⟶⋆↯)
<$> small⇒big⟶∞ y B y⟶∞
helper (no x↛⋆↯) = Catch₁ <$> small⇒big⟶∞ x i x⟶∞
where x⟶∞ = ⋆∞⇒∞ (Catch.lemma ⟶∞) x↛⋆↯
small⇒big⟶∞ (run (block x)) i ⟶∞ = Block <$> small⇒big⟶∞ x B (Block.lemma ⟶∞)
small⇒big⟶∞ (run (unblock x)) i ⟶∞ = Unblock <$> small⇒big⟶∞ x U (Unblock.lemma ⟶∞)
small⇒big : Small⇒Big
small⇒big = record { ⟶⋆ = small⇒big⟶⋆; ⟶∞ = small⇒big⟶∞ }