Trouble with coinduction.

Semantics.agda

open import Coinduction

open import Data.Fin hiding (_+_ ; #_)
open import Data.Nat
open import Data.Vec

module Semantics where

  -- syntax definition for imp programs

  infixl 4 _⊕_

  data Exp (n : ℕ) : Set where
    $_  : ℕ → Exp n
    Var : Fin n → Exp n
    _⊕_ : Exp n → Exp n → Exp n

  infix 2 _≔_
  infixl 3 _▷_
  infix 1 iif_then_else_

  data Stmt (n : ℕ) : Set where
    skip : Stmt n
    _≔_ : Fin n → Exp n → Stmt n
    _▷_ : Stmt n → Stmt n → Stmt n
    iif_then_else_ : Exp n → Stmt n → Stmt n → Stmt n
    while_do_ : Exp n → Stmt n → Stmt n
    _∥_ : Stmt n → Stmt n → Stmt n
    atomic : Stmt n → Stmt n
    await_do_ : Exp n → Stmt n → Stmt n


  -- definition of state

  σ_ : ℕ → Set
  σ n = Vec ℕ n

  infixl 4 _∨_
  
  -- definition of resumptions

  data Res (n : ℕ) : Set where
    ret : (st : σ n) → Res n
    δ   : (r : ∞ (Res n)) → Res n
    _∨_ : (l r : ∞ (Res n)) → Res n
    yield : (s : Stmt n)(st : σ n) → Res n
    
  -- semantics of expressions

  infix 1 ⟦_,_⟧

  ⟦_,_⟧ : ∀ {n} → Exp n → σ n → ℕ
  ⟦ $ n , s ⟧ = n
  ⟦ Var v , s ⟧ = lookup v s
  ⟦ e ⊕ e' , s ⟧ = ⟦ e , s ⟧ + ⟦ e' , s ⟧

  
  evalSeq : ∀ {n} → Stmt n → Res n → Res n
  evalSeq s (ret st) = yield s st
  evalSeq s (δ r) = δ (♯ (evalSeq s (♭ r)))
  evalSeq s (l ∨ r) = ♯ evalSeq s (♭ l) ∨  ♯ evalSeq s (♭ r)
  evalSeq s (yield s' st) = yield (s ▷ s') st

  evalParL : ∀ {n} → Stmt n → Res n → Res n
  evalParL s (ret st) = yield s st
  evalParL s (δ r) = δ (♯ evalParL s (♭ r))
  evalParL s (l ∨ r) = ♯ evalParL s (♭ l) ∨ ♯ evalParL s (♭ r)
  evalParL s (yield s' st) = yield (s ∥ s') st

  evalParR : ∀ {n} → Stmt n → Res n → Res n
  evalParR s (ret st) = yield s st
  evalParR s (δ r) = δ (♯ evalParR s (♭ r))
  evalParR s (l ∨ r) = ♯ evalParR s (♭ l) ∨ ♯ evalParR s (♭ r)
  evalParR s (yield s' st) = yield (s' ∥ s) st

  mutual
    close : ∀ {n} → Res n → Res n
    close (ret st) = ret st
    close (δ r) = δ (♯ close (♭ r))
    close (l ∨ r) = ♯ close (♭ l) ∨ ♯ close (♭ r)
    close (yield s st) = δ (♯ eval s st)

    eval : ∀ {n} → Stmt n → σ n → Res n
    eval skip st = ret st
    eval (x ≔ e) st = δ (♯ (ret (st [ x ]≔ ⟦ e , st ⟧ )))
    eval (s ▷ s') st = evalSeq s (eval s' st)
    eval (iif e then s else s') st with ⟦ e , st ⟧
    ...| zero = δ (♯ yield s' st)
    ...| suc n = δ (♯ yield s st)
    eval (while e do s) st with ⟦ e , st ⟧
    ...| zero = δ (♯ ret st)
    ...| suc n = δ (♯ yield (s ▷ while e do s) st )
    eval (s ∥ s') st = (♯ evalParR s' (eval s st)) ∨ (♯ evalParL s (eval s' st))
    eval (atomic s) st = {!!} -- δ (♯ close (eval s st))
    eval (await e do s) st = {!!}