module DanvyFirstAttempt where
open import Data.Nat
open import Derivation
open import Relation.Binary.PropositionalEquality
open ≡-Reasoning
open import Function hiding (_∋_)
module Language where
infixl 70 _·_
infix 50 ƛ_
infixr 30 _⟶_
infixl 20 _▻_ _▷_
infix 10 _∋_ _⊢_
data Ty : Set where
Nat : Ty
_⟶_ : Ty -> Ty -> Ty
data Ctxt : Set where
ε : Ctxt
_▻_ : Ctxt -> Ty -> Ctxt
data _∋_ : Ctxt -> Ty -> Set where
vz : forall {Γ σ} -> Γ ▻ σ ∋ σ
vs : forall {Γ σ τ} -> Γ ∋ τ -> Γ ▻ σ ∋ τ
data _⊢_ : Ctxt -> Ty -> Set where
var : forall {Γ τ} -> Γ ∋ τ -> Γ ⊢ τ
ƛ_ : forall {Γ σ τ} -> Γ ▻ σ ⊢ τ -> Γ ⊢ σ ⟶ τ
_·_ : forall {Γ σ τ} -> Γ ⊢ σ ⟶ τ -> Γ ⊢ σ -> Γ ⊢ τ
⟦_⟧⋆ : Ty -> Set
⟦ Nat ⟧⋆ = ℕ
⟦ σ ⟶ τ ⟧⋆ = ⟦ σ ⟧⋆ -> ⟦ τ ⟧⋆
data Env : Ctxt -> Set where
∅ : Env ε
_▷_ : forall {Γ τ} -> Env Γ -> ⟦ τ ⟧⋆ -> Env (Γ ▻ τ)
Dom : Ctxt -> Ty -> Set
Dom Γ τ = Env Γ -> ⟦ τ ⟧⋆
lookup : forall {Γ τ} -> Γ ∋ τ -> Dom Γ τ
lookup vz (ρ ▷ v) = v
lookup (vs x) (ρ ▷ v) = lookup x ρ
⟦_⟧ : forall {Γ τ} -> Γ ⊢ τ -> Dom Γ τ
⟦ var x ⟧ ρ = lookup x ρ
⟦ ƛ t ⟧ ρ = \v -> ⟦ t ⟧ (ρ ▷ v)
⟦ t₁ · t₂ ⟧ ρ = ⟦ t₁ ⟧ ρ (⟦ t₂ ⟧ ρ)
module Step₁ where
open Language
infixl 70 _⊙_
infix 50 Λ_
Λ_ : forall {Γ σ τ} -> Dom (Γ ▻ σ) τ -> Dom Γ (σ ⟶ τ)
Λ_ = \f ρ v -> f (ρ ▷ v)
_⊙_ : forall {Γ σ τ} -> Dom Γ (σ ⟶ τ) -> Dom Γ σ -> Dom Γ τ
_⊙_ = \f g ρ -> f ρ (g ρ)
mutual
⟦_⟧' : forall {Γ τ} -> Γ ⊢ τ -> Env Γ -> ⟦ τ ⟧⋆
⟦ t ⟧' = witness ⟦ t ⟧'P
⟦_⟧'P : forall {Γ τ} (t : Γ ⊢ τ) -> EqualTo ⟦ t ⟧
⟦ var x ⟧'P = ▷ begin lookup x ∎
⟦ ƛ t ⟧'P = ▷ begin
(\ρ v -> ⟦ t ⟧ (ρ ▷ v))
≡⟨ refl ⟩
Λ ⟦ t ⟧
∎
⟦ t₁ · t₂ ⟧'P = ▷ begin
(\ρ -> ⟦ t₁ ⟧ ρ (⟦ t₂ ⟧ ρ))
≡⟨ refl ⟩
⟦ t₁ ⟧ ⊙ ⟦ t₂ ⟧
∎
module Step₂ where
open Language hiding (Dom; lookup; ⟦_⟧)
record Model : Set1 where
infixl 70 _⊙_
infix 50 Λ_
field
Dom : Ctxt -> Ty -> Set
lookup : forall {Γ τ} -> Γ ∋ τ -> Dom Γ τ
Λ_ : forall {Γ σ τ} -> Dom (Γ ▻ σ) τ -> Dom Γ (σ ⟶ τ)
_⊙_ : forall {Γ σ τ} -> Dom Γ (σ ⟶ τ) -> Dom Γ σ -> Dom Γ τ
⟦_⟧ : forall {Γ τ} -> Γ ⊢ τ -> Dom Γ τ
⟦ var x ⟧ = lookup x
⟦ ƛ t ⟧ = Λ ⟦ t ⟧
⟦ t₁ · t₂ ⟧ = ⟦ t₁ ⟧ ⊙ ⟦ t₂ ⟧
eval : Model
eval = record
{ Dom = Language.Dom
; lookup = Language.lookup
; Λ_ = Step₁.Λ_
; _⊙_ = Step₁._⊙_
}
eval-correct : forall {Γ τ} (t : Γ ⊢ τ) ->
let open Model eval in
⟦ t ⟧ ≡ Language.⟦_⟧ t
eval-correct (var x) = refl
eval-correct (ƛ t) = cong Step₁.Λ_ (eval-correct t)
eval-correct (t₁ · t₂) =
cong₂ Step₁._⊙_ (eval-correct t₁) (eval-correct t₂)
term : Model
term = record
{ Dom = _⊢_
; lookup = var
; Λ_ = ƛ_
; _⊙_ = _·_
}
term-uninteresting : forall {Γ τ} (t : Γ ⊢ τ) ->
let open Model term in
⟦ t ⟧ ≡ t
term-uninteresting (var x) = refl
term-uninteresting (ƛ t) = cong ƛ_ (term-uninteresting t)
term-uninteresting (t₁ · t₂) =
cong₂ _·_ (term-uninteresting t₁) (term-uninteresting t₂)
Interpreter : Model -> Model -> Set
Interpreter from to = forall {Γ τ} ->
Model.Dom from Γ τ -> Model.Dom to Γ τ
Correct : (from to : Model) -> Interpreter from to -> Set
Correct from to f = forall {Γ τ} (t : Γ ⊢ τ) ->
f (Model.⟦_⟧ from t) ≡ Model.⟦_⟧ to t