297 lines
13 KiB
Agda
297 lines
13 KiB
Agda
module Analysis.Sign where
|
||
|
||
open import Data.Integer as Int using (ℤ; +_; -[1+_])
|
||
open import Data.Nat as Nat using (ℕ; suc; zero)
|
||
open import Data.Product using (Σ; proj₁; proj₂; _,_)
|
||
open import Data.Sum using (inj₁; inj₂)
|
||
open import Data.Empty using (⊥; ⊥-elim)
|
||
open import Data.Unit using (⊤; tt)
|
||
open import Data.List.Membership.Propositional as MemProp using () renaming (_∈_ to _∈ˡ_)
|
||
open import Relation.Binary.PropositionalEquality using (_≡_; refl; sym; trans; subst)
|
||
open import Relation.Nullary using (¬_; yes; no)
|
||
|
||
open import Language
|
||
open import Lattice
|
||
open import Showable using (Showable; show)
|
||
open import Utils using (_⇒_; _∧_; _∨_)
|
||
import Analysis.Forward
|
||
|
||
data Sign : Set where
|
||
+ : Sign
|
||
- : Sign
|
||
0ˢ : Sign
|
||
|
||
instance
|
||
showable : Showable Sign
|
||
showable = record
|
||
{ show = (λ
|
||
{ + → "+"
|
||
; - → "-"
|
||
; 0ˢ → "0"
|
||
})
|
||
}
|
||
|
||
-- g for siGn; s is used for strings and i is not very descriptive.
|
||
_≟ᵍ_ : IsDecidable (_≡_ {_} {Sign})
|
||
_≟ᵍ_ + + = yes refl
|
||
_≟ᵍ_ + - = no (λ ())
|
||
_≟ᵍ_ + 0ˢ = no (λ ())
|
||
_≟ᵍ_ - + = no (λ ())
|
||
_≟ᵍ_ - - = yes refl
|
||
_≟ᵍ_ - 0ˢ = no (λ ())
|
||
_≟ᵍ_ 0ˢ + = no (λ ())
|
||
_≟ᵍ_ 0ˢ - = no (λ ())
|
||
_≟ᵍ_ 0ˢ 0ˢ = yes refl
|
||
|
||
-- embelish 'sign' with a top and bottom element.
|
||
open import Lattice.AboveBelow Sign _≡_ (record { ≈-refl = refl; ≈-sym = sym; ≈-trans = trans }) _≟ᵍ_ as AB
|
||
using ()
|
||
renaming
|
||
( AboveBelow to SignLattice
|
||
; ≈-dec to ≈ᵍ-dec
|
||
; ⊥ to ⊥ᵍ
|
||
; ⊤ to ⊤ᵍ
|
||
; [_] to [_]ᵍ
|
||
; _≈_ to _≈ᵍ_
|
||
; ≈-⊥-⊥ to ≈ᵍ-⊥ᵍ-⊥ᵍ
|
||
; ≈-⊤-⊤ to ≈ᵍ-⊤ᵍ-⊤ᵍ
|
||
; ≈-lift to ≈ᵍ-lift
|
||
; ≈-refl to ≈ᵍ-refl
|
||
)
|
||
-- 'sign' has no underlying lattice structure, so use the 'plain' above-below lattice.
|
||
open AB.Plain 0ˢ using ()
|
||
renaming
|
||
( isLattice to isLatticeᵍ
|
||
; fixedHeight to fixedHeightᵍ
|
||
; _≼_ to _≼ᵍ_
|
||
; _⊔_ to _⊔ᵍ_
|
||
; _⊓_ to _⊓ᵍ_
|
||
)
|
||
|
||
open IsLattice isLatticeᵍ using ()
|
||
renaming
|
||
( ≼-trans to ≼ᵍ-trans
|
||
)
|
||
|
||
plus : SignLattice → SignLattice → SignLattice
|
||
plus ⊥ᵍ _ = ⊥ᵍ
|
||
plus _ ⊥ᵍ = ⊥ᵍ
|
||
plus ⊤ᵍ _ = ⊤ᵍ
|
||
plus _ ⊤ᵍ = ⊤ᵍ
|
||
plus [ + ]ᵍ [ + ]ᵍ = [ + ]ᵍ
|
||
plus [ + ]ᵍ [ - ]ᵍ = ⊤ᵍ
|
||
plus [ + ]ᵍ [ 0ˢ ]ᵍ = [ + ]ᵍ
|
||
plus [ - ]ᵍ [ + ]ᵍ = ⊤ᵍ
|
||
plus [ - ]ᵍ [ - ]ᵍ = [ - ]ᵍ
|
||
plus [ - ]ᵍ [ 0ˢ ]ᵍ = [ - ]ᵍ
|
||
plus [ 0ˢ ]ᵍ [ + ]ᵍ = [ + ]ᵍ
|
||
plus [ 0ˢ ]ᵍ [ - ]ᵍ = [ - ]ᵍ
|
||
plus [ 0ˢ ]ᵍ [ 0ˢ ]ᵍ = [ 0ˢ ]ᵍ
|
||
|
||
-- this is incredibly tedious: 125 cases per monotonicity proof, and tactics
|
||
-- are hard. postulate for now.
|
||
postulate plus-Monoˡ : ∀ (s₂ : SignLattice) → Monotonic _≼ᵍ_ _≼ᵍ_ (λ s₁ → plus s₁ s₂)
|
||
postulate plus-Monoʳ : ∀ (s₁ : SignLattice) → Monotonic _≼ᵍ_ _≼ᵍ_ (plus s₁)
|
||
|
||
minus : SignLattice → SignLattice → SignLattice
|
||
minus ⊥ᵍ _ = ⊥ᵍ
|
||
minus _ ⊥ᵍ = ⊥ᵍ
|
||
minus ⊤ᵍ _ = ⊤ᵍ
|
||
minus _ ⊤ᵍ = ⊤ᵍ
|
||
minus [ + ]ᵍ [ + ]ᵍ = ⊤ᵍ
|
||
minus [ + ]ᵍ [ - ]ᵍ = [ + ]ᵍ
|
||
minus [ + ]ᵍ [ 0ˢ ]ᵍ = [ + ]ᵍ
|
||
minus [ - ]ᵍ [ + ]ᵍ = [ - ]ᵍ
|
||
minus [ - ]ᵍ [ - ]ᵍ = ⊤ᵍ
|
||
minus [ - ]ᵍ [ 0ˢ ]ᵍ = [ - ]ᵍ
|
||
minus [ 0ˢ ]ᵍ [ + ]ᵍ = [ - ]ᵍ
|
||
minus [ 0ˢ ]ᵍ [ - ]ᵍ = [ + ]ᵍ
|
||
minus [ 0ˢ ]ᵍ [ 0ˢ ]ᵍ = [ 0ˢ ]ᵍ
|
||
|
||
postulate minus-Monoˡ : ∀ (s₂ : SignLattice) → Monotonic _≼ᵍ_ _≼ᵍ_ (λ s₁ → minus s₁ s₂)
|
||
postulate minus-Monoʳ : ∀ (s₁ : SignLattice) → Monotonic _≼ᵍ_ _≼ᵍ_ (minus s₁)
|
||
|
||
⟦_⟧ᵍ : SignLattice → Value → Set
|
||
⟦_⟧ᵍ ⊥ᵍ _ = ⊥
|
||
⟦_⟧ᵍ ⊤ᵍ _ = ⊤
|
||
⟦_⟧ᵍ [ + ]ᵍ v = Σ ℕ (λ n → v ≡ ↑ᶻ (+_ (suc n)))
|
||
⟦_⟧ᵍ [ 0ˢ ]ᵍ v = v ≡ ↑ᶻ (+_ zero)
|
||
⟦_⟧ᵍ [ - ]ᵍ v = Σ ℕ (λ n → v ≡ ↑ᶻ -[1+ n ])
|
||
|
||
⟦⟧ᵍ-respects-≈ᵍ : ∀ {s₁ s₂ : SignLattice} → s₁ ≈ᵍ s₂ → ⟦ s₁ ⟧ᵍ ⇒ ⟦ s₂ ⟧ᵍ
|
||
⟦⟧ᵍ-respects-≈ᵍ ≈ᵍ-⊥ᵍ-⊥ᵍ v bot = bot
|
||
⟦⟧ᵍ-respects-≈ᵍ ≈ᵍ-⊤ᵍ-⊤ᵍ v top = top
|
||
⟦⟧ᵍ-respects-≈ᵍ (≈ᵍ-lift { + } { + } refl) v proof = proof
|
||
⟦⟧ᵍ-respects-≈ᵍ (≈ᵍ-lift { - } { - } refl) v proof = proof
|
||
⟦⟧ᵍ-respects-≈ᵍ (≈ᵍ-lift { 0ˢ } { 0ˢ } refl) v proof = proof
|
||
|
||
⟦⟧ᵍ-⊔ᵍ-∨ : ∀ {s₁ s₂ : SignLattice} → (⟦ s₁ ⟧ᵍ ∨ ⟦ s₂ ⟧ᵍ) ⇒ ⟦ s₁ ⊔ᵍ s₂ ⟧ᵍ
|
||
⟦⟧ᵍ-⊔ᵍ-∨ {⊥ᵍ} x (inj₂ px₂) = px₂
|
||
⟦⟧ᵍ-⊔ᵍ-∨ {⊤ᵍ} x _ = tt
|
||
⟦⟧ᵍ-⊔ᵍ-∨ {[ s₁ ]ᵍ} {[ s₂ ]ᵍ} x px
|
||
with s₁ ≟ᵍ s₂
|
||
... | no _ = tt
|
||
... | yes refl
|
||
with px
|
||
... | inj₁ px₁ = px₁
|
||
... | inj₂ px₂ = px₂
|
||
⟦⟧ᵍ-⊔ᵍ-∨ {[ s₁ ]ᵍ} {⊥ᵍ} x (inj₁ px₁) = px₁
|
||
⟦⟧ᵍ-⊔ᵍ-∨ {[ s₁ ]ᵍ} {⊤ᵍ} x _ = tt
|
||
|
||
s₁≢s₂⇒¬s₁∧s₂ : ∀ {s₁ s₂ : Sign} → ¬ s₁ ≡ s₂ → ∀ {v} → ¬ ((⟦ [ s₁ ]ᵍ ⟧ᵍ ∧ ⟦ [ s₂ ]ᵍ ⟧ᵍ) v)
|
||
s₁≢s₂⇒¬s₁∧s₂ { + } { + } +≢+ _ = ⊥-elim (+≢+ refl)
|
||
s₁≢s₂⇒¬s₁∧s₂ { + } { - } _ ((n , refl) , (m , ()))
|
||
s₁≢s₂⇒¬s₁∧s₂ { + } { 0ˢ } _ ((n , refl) , ())
|
||
s₁≢s₂⇒¬s₁∧s₂ { 0ˢ } { + } _ (refl , (m , ()))
|
||
s₁≢s₂⇒¬s₁∧s₂ { 0ˢ } { 0ˢ } +≢+ _ = ⊥-elim (+≢+ refl)
|
||
s₁≢s₂⇒¬s₁∧s₂ { 0ˢ } { - } _ (refl , (m , ()))
|
||
s₁≢s₂⇒¬s₁∧s₂ { - } { + } _ ((n , refl) , (m , ()))
|
||
s₁≢s₂⇒¬s₁∧s₂ { - } { 0ˢ } _ ((n , refl) , ())
|
||
s₁≢s₂⇒¬s₁∧s₂ { - } { - } +≢+ _ = ⊥-elim (+≢+ refl)
|
||
|
||
⟦⟧ᵍ-⊓ᵍ-∧ : ∀ {s₁ s₂ : SignLattice} → (⟦ s₁ ⟧ᵍ ∧ ⟦ s₂ ⟧ᵍ) ⇒ ⟦ s₁ ⊓ᵍ s₂ ⟧ᵍ
|
||
⟦⟧ᵍ-⊓ᵍ-∧ {⊥ᵍ} x (bot , _) = bot
|
||
⟦⟧ᵍ-⊓ᵍ-∧ {⊤ᵍ} x (_ , px₂) = px₂
|
||
⟦⟧ᵍ-⊓ᵍ-∧ {[ s₁ ]ᵍ} {[ s₂ ]ᵍ} x (px₁ , px₂)
|
||
with s₁ ≟ᵍ s₂
|
||
... | no s₁≢s₂ = s₁≢s₂⇒¬s₁∧s₂ s₁≢s₂ (px₁ , px₂)
|
||
... | yes refl = px₁
|
||
⟦⟧ᵍ-⊓ᵍ-∧ {[ g₁ ]ᵍ} {⊥ᵍ} x (_ , bot) = bot
|
||
⟦⟧ᵍ-⊓ᵍ-∧ {[ g₁ ]ᵍ} {⊤ᵍ} x (px₁ , _) = px₁
|
||
|
||
latticeInterpretationᵍ : LatticeInterpretation isLatticeᵍ
|
||
latticeInterpretationᵍ = record
|
||
{ ⟦_⟧ = ⟦_⟧ᵍ
|
||
; ⟦⟧-respects-≈ = ⟦⟧ᵍ-respects-≈ᵍ
|
||
; ⟦⟧-⊔-∨ = ⟦⟧ᵍ-⊔ᵍ-∨
|
||
; ⟦⟧-⊓-∧ = ⟦⟧ᵍ-⊓ᵍ-∧
|
||
}
|
||
|
||
module WithProg (prog : Program) where
|
||
open Program prog
|
||
|
||
module ForwardWithProg = Analysis.Forward.WithProg (record { isLattice = isLatticeᵍ; fixedHeight = fixedHeightᵍ }) ≈ᵍ-dec prog
|
||
open ForwardWithProg
|
||
|
||
eval : ∀ (e : Expr) → VariableValues → SignLattice
|
||
eval (e₁ + e₂) vs = plus (eval e₁ vs) (eval e₂ vs)
|
||
eval (e₁ - e₂) vs = minus (eval e₁ vs) (eval e₂ vs)
|
||
eval (` k) vs
|
||
with ∈k-decᵛ k (proj₁ (proj₁ vs))
|
||
... | yes k∈vs = proj₁ (locateᵛ {k} {vs} k∈vs)
|
||
... | no _ = ⊤ᵍ
|
||
eval (# 0) _ = [ 0ˢ ]ᵍ
|
||
eval (# (suc n')) _ = [ + ]ᵍ
|
||
|
||
eval-Mono : ∀ (e : Expr) → Monotonic _≼ᵛ_ _≼ᵍ_ (eval e)
|
||
eval-Mono (e₁ + e₂) {vs₁} {vs₂} vs₁≼vs₂ =
|
||
let
|
||
-- TODO: can this be done with less boilerplate?
|
||
g₁vs₁ = eval e₁ vs₁
|
||
g₂vs₁ = eval e₂ vs₁
|
||
g₁vs₂ = eval e₁ vs₂
|
||
g₂vs₂ = eval e₂ vs₂
|
||
in
|
||
≼ᵍ-trans
|
||
{plus g₁vs₁ g₂vs₁} {plus g₁vs₂ g₂vs₁} {plus g₁vs₂ g₂vs₂}
|
||
(plus-Monoˡ g₂vs₁ {g₁vs₁} {g₁vs₂} (eval-Mono e₁ {vs₁} {vs₂} vs₁≼vs₂))
|
||
(plus-Monoʳ g₁vs₂ {g₂vs₁} {g₂vs₂} (eval-Mono e₂ {vs₁} {vs₂} vs₁≼vs₂))
|
||
eval-Mono (e₁ - e₂) {vs₁} {vs₂} vs₁≼vs₂ =
|
||
let
|
||
-- TODO: here too -- can this be done with less boilerplate?
|
||
g₁vs₁ = eval e₁ vs₁
|
||
g₂vs₁ = eval e₂ vs₁
|
||
g₁vs₂ = eval e₁ vs₂
|
||
g₂vs₂ = eval e₂ vs₂
|
||
in
|
||
≼ᵍ-trans
|
||
{minus g₁vs₁ g₂vs₁} {minus g₁vs₂ g₂vs₁} {minus g₁vs₂ g₂vs₂}
|
||
(minus-Monoˡ g₂vs₁ {g₁vs₁} {g₁vs₂} (eval-Mono e₁ {vs₁} {vs₂} vs₁≼vs₂))
|
||
(minus-Monoʳ g₁vs₂ {g₂vs₁} {g₂vs₂} (eval-Mono e₂ {vs₁} {vs₂} vs₁≼vs₂))
|
||
eval-Mono (` k) {vs₁@((kvs₁ , _) , _)} {vs₂@((kvs₂ , _), _)} vs₁≼vs₂
|
||
with ∈k-decᵛ k kvs₁ | ∈k-decᵛ k kvs₂
|
||
... | yes k∈kvs₁ | yes k∈kvs₂ =
|
||
let
|
||
(v₁ , k,v₁∈vs₁) = locateᵛ {k} {vs₁} k∈kvs₁
|
||
(v₂ , k,v₂∈vs₂) = locateᵛ {k} {vs₂} k∈kvs₂
|
||
in
|
||
m₁≼m₂⇒m₁[k]ᵛ≼m₂[k]ᵛ vs₁ vs₂ vs₁≼vs₂ k,v₁∈vs₁ k,v₂∈vs₂
|
||
... | yes k∈kvs₁ | no k∉kvs₂ = ⊥-elim (k∉kvs₂ (subst (λ l → k ∈ˡ l) (all-equal-keysᵛ vs₁ vs₂) k∈kvs₁))
|
||
... | no k∉kvs₁ | yes k∈kvs₂ = ⊥-elim (k∉kvs₁ (subst (λ l → k ∈ˡ l) (all-equal-keysᵛ vs₂ vs₁) k∈kvs₂))
|
||
... | no k∉kvs₁ | no k∉kvs₂ = IsLattice.≈-refl isLatticeᵍ
|
||
eval-Mono (# 0) _ = ≈ᵍ-refl
|
||
eval-Mono (# (suc n')) _ = ≈ᵍ-refl
|
||
|
||
module ForwardWithEval = ForwardWithProg.WithEvaluator eval eval-Mono
|
||
open ForwardWithEval using (result)
|
||
|
||
-- For debugging purposes, print out the result.
|
||
output = show result
|
||
|
||
module ForwardWithInterp = ForwardWithEval.WithInterpretation latticeInterpretationᵍ
|
||
open ForwardWithInterp using (⟦_⟧ᵛ; InterpretationValid)
|
||
|
||
-- This should have fewer cases -- the same number as the actual 'plus' above.
|
||
-- But agda only simplifies on first argument, apparently, so we are stuck
|
||
-- listing them all.
|
||
plus-valid : ∀ {g₁ g₂} {z₁ z₂} → ⟦ g₁ ⟧ᵍ (↑ᶻ z₁) → ⟦ g₂ ⟧ᵍ (↑ᶻ z₂) → ⟦ plus g₁ g₂ ⟧ᵍ (↑ᶻ (z₁ Int.+ z₂))
|
||
plus-valid {⊥ᵍ} {_} ⊥ _ = ⊥
|
||
plus-valid {[ + ]ᵍ} {⊥ᵍ} _ ⊥ = ⊥
|
||
plus-valid {[ - ]ᵍ} {⊥ᵍ} _ ⊥ = ⊥
|
||
plus-valid {[ 0ˢ ]ᵍ} {⊥ᵍ} _ ⊥ = ⊥
|
||
plus-valid {⊤ᵍ} {⊥ᵍ} _ ⊥ = ⊥
|
||
plus-valid {⊤ᵍ} {[ + ]ᵍ} _ _ = tt
|
||
plus-valid {⊤ᵍ} {[ - ]ᵍ} _ _ = tt
|
||
plus-valid {⊤ᵍ} {[ 0ˢ ]ᵍ} _ _ = tt
|
||
plus-valid {⊤ᵍ} {⊤ᵍ} _ _ = tt
|
||
plus-valid {[ + ]ᵍ} {[ + ]ᵍ} (n₁ , refl) (n₂ , refl) = (_ , refl)
|
||
plus-valid {[ + ]ᵍ} {[ - ]ᵍ} _ _ = tt
|
||
plus-valid {[ + ]ᵍ} {[ 0ˢ ]ᵍ} (n₁ , refl) refl = (_ , refl)
|
||
plus-valid {[ + ]ᵍ} {⊤ᵍ} _ _ = tt
|
||
plus-valid {[ - ]ᵍ} {[ + ]ᵍ} _ _ = tt
|
||
plus-valid {[ - ]ᵍ} {[ - ]ᵍ} (n₁ , refl) (n₂ , refl) = (_ , refl)
|
||
plus-valid {[ - ]ᵍ} {[ 0ˢ ]ᵍ} (n₁ , refl) refl = (_ , refl)
|
||
plus-valid {[ - ]ᵍ} {⊤ᵍ} _ _ = tt
|
||
plus-valid {[ 0ˢ ]ᵍ} {[ + ]ᵍ} refl (n₂ , refl) = (_ , refl)
|
||
plus-valid {[ 0ˢ ]ᵍ} {[ - ]ᵍ} refl (n₂ , refl) = (_ , refl)
|
||
plus-valid {[ 0ˢ ]ᵍ} {[ 0ˢ ]ᵍ} refl refl = refl
|
||
plus-valid {[ 0ˢ ]ᵍ} {⊤ᵍ} _ _ = tt
|
||
|
||
-- Same for this one. It should be easier, but Agda won't simplify.
|
||
minus-valid : ∀ {g₁ g₂} {z₁ z₂} → ⟦ g₁ ⟧ᵍ (↑ᶻ z₁) → ⟦ g₂ ⟧ᵍ (↑ᶻ z₂) → ⟦ minus g₁ g₂ ⟧ᵍ (↑ᶻ (z₁ Int.- z₂))
|
||
minus-valid {⊥ᵍ} {_} ⊥ _ = ⊥
|
||
minus-valid {[ + ]ᵍ} {⊥ᵍ} _ ⊥ = ⊥
|
||
minus-valid {[ - ]ᵍ} {⊥ᵍ} _ ⊥ = ⊥
|
||
minus-valid {[ 0ˢ ]ᵍ} {⊥ᵍ} _ ⊥ = ⊥
|
||
minus-valid {⊤ᵍ} {⊥ᵍ} _ ⊥ = ⊥
|
||
minus-valid {⊤ᵍ} {[ + ]ᵍ} _ _ = tt
|
||
minus-valid {⊤ᵍ} {[ - ]ᵍ} _ _ = tt
|
||
minus-valid {⊤ᵍ} {[ 0ˢ ]ᵍ} _ _ = tt
|
||
minus-valid {⊤ᵍ} {⊤ᵍ} _ _ = tt
|
||
minus-valid {[ + ]ᵍ} {[ + ]ᵍ} _ _ = tt
|
||
minus-valid {[ + ]ᵍ} {[ - ]ᵍ} (n₁ , refl) (n₂ , refl) = (_ , refl)
|
||
minus-valid {[ + ]ᵍ} {[ 0ˢ ]ᵍ} (n₁ , refl) refl = (_ , refl)
|
||
minus-valid {[ + ]ᵍ} {⊤ᵍ} _ _ = tt
|
||
minus-valid {[ - ]ᵍ} {[ + ]ᵍ} (n₁ , refl) (n₂ , refl) = (_ , refl)
|
||
minus-valid {[ - ]ᵍ} {[ - ]ᵍ} _ _ = tt
|
||
minus-valid {[ - ]ᵍ} {[ 0ˢ ]ᵍ} (n₁ , refl) refl = (_ , refl)
|
||
minus-valid {[ - ]ᵍ} {⊤ᵍ} _ _ = tt
|
||
minus-valid {[ 0ˢ ]ᵍ} {[ + ]ᵍ} refl (n₂ , refl) = (_ , refl)
|
||
minus-valid {[ 0ˢ ]ᵍ} {[ - ]ᵍ} refl (n₂ , refl) = (_ , refl)
|
||
minus-valid {[ 0ˢ ]ᵍ} {[ 0ˢ ]ᵍ} refl refl = refl
|
||
minus-valid {[ 0ˢ ]ᵍ} {⊤ᵍ} _ _ = tt
|
||
|
||
eval-Valid : InterpretationValid
|
||
eval-Valid (⇒ᵉ-+ ρ e₁ e₂ z₁ z₂ ρ,e₁⇒z₁ ρ,e₂⇒z₂) ⟦vs⟧ρ =
|
||
plus-valid (eval-Valid ρ,e₁⇒z₁ ⟦vs⟧ρ) (eval-Valid ρ,e₂⇒z₂ ⟦vs⟧ρ)
|
||
eval-Valid (⇒ᵉ-- ρ e₁ e₂ z₁ z₂ ρ,e₁⇒z₁ ρ,e₂⇒z₂) ⟦vs⟧ρ =
|
||
minus-valid (eval-Valid ρ,e₁⇒z₁ ⟦vs⟧ρ) (eval-Valid ρ,e₂⇒z₂ ⟦vs⟧ρ)
|
||
eval-Valid {vs} (⇒ᵉ-Var ρ x v x,v∈ρ) ⟦vs⟧ρ
|
||
with ∈k-decᵛ x (proj₁ (proj₁ vs))
|
||
... | yes x∈kvs = ⟦vs⟧ρ (proj₂ (locateᵛ {x} {vs} x∈kvs)) x,v∈ρ
|
||
... | no x∉kvs = tt
|
||
eval-Valid (⇒ᵉ-ℕ ρ 0) _ = refl
|
||
eval-Valid (⇒ᵉ-ℕ ρ (suc n')) _ = (n' , refl)
|
||
|
||
open ForwardWithInterp.WithValidity eval-Valid using (analyze-correct) public
|