module l13 where
open import Data.Nat
open import Data.Bool
open import Data.Maybe
open import Data.Product
open import Relation.Nullary
open import Relation.Binary.PropositionalEquality
infix 3 _≤E_
infix 4 _+E_
data Expr : Set where
nat : ℕ → Expr
bool : Bool → Expr
_+E_ : Expr → Expr → Expr
_≤E_ : Expr → Expr → Expr
ifE_then_else_ : Expr → Expr → Expr → Expr
e1 : Expr
e1 = ifE (nat 3) ≤E (nat 4) then (nat 4) +E (nat 1) else (nat 0)
e2 : Expr
e2 = (nat 3) ≤E (nat 4) +E (nat 5)
e3 : Expr
e3 = ((nat 3) ≤E (nat 4)) +E (nat 5)
data Val : Set where
nat : ℕ → Val
bool : Bool → Val
return : {A : Set} → A → Maybe A
return a = just a
infix 2 _>>=_
_>>=_ : {A B : Set} → Maybe A → (A → Maybe B) → Maybe B
just a >>= f = f a
nothing >>= f = nothing
_+v_ : Val → Val → Maybe Val
nat m +v nat n = return (nat (m + n))
_ +v _ = nothing
dec2bool : {A : Set} → Dec A → Bool
dec2bool (yes p) = true
dec2bool (no ¬p) = false
_≤v_ : Val → Val → Maybe Val
nat m ≤v nat n = return (bool (dec2bool (m ≤? n)))
_ ≤v _ = nothing
ifV_then_else_ : Val → Val → Val → Maybe Val
ifV bool b then v else v' = return (if b then v else v')
ifV _ then _ else _ = nothing
⟦_⟧ : Expr → Maybe Val
⟦ nat n ⟧ = return (nat n)
⟦ bool b ⟧ = return (bool b)
⟦ e +E e' ⟧ = ⟦ e ⟧ >>= λ v →
⟦ e' ⟧ >>= λ v' →
v +v v'
⟦ e ≤E e' ⟧ = ⟦ e ⟧ >>= λ v →
⟦ e' ⟧ >>= λ v' →
v ≤v v'
⟦ ifE e then e' else e'' ⟧ = ⟦ e ⟧ >>= λ v →
⟦ e' ⟧ >>= λ v' →
⟦ e'' ⟧ >>= λ v'' →
ifV v then v' else v''
v1 : Maybe Val
v1 = ⟦ e1 ⟧
v2 : Maybe Val
v2 = ⟦ e2 ⟧
v3 : Maybe Val
v3 = ⟦ e3 ⟧
data Ty : Set where
nat : Ty
bool : Ty
data TVal : Ty → Set where
nat : ℕ → TVal nat
bool : Bool → TVal bool
data TExpr : Ty → Set where
nat : ℕ → TExpr nat
bool : Bool → TExpr bool
_+E_ : TExpr nat → TExpr nat → TExpr nat
_≤E_ : TExpr nat → TExpr nat → TExpr bool
ifE_then_else_ : {σ : Ty} → TExpr bool → TExpr σ → TExpr σ → TExpr σ
⟦_⟧T : {σ : Ty} → TExpr σ → TVal σ
⟦ nat n ⟧T = nat n
⟦ bool b ⟧T = bool b
⟦ e +E e' ⟧T with ⟦ e ⟧T | ⟦ e' ⟧T
... | nat m | nat n = nat (m + n)
⟦ e ≤E e' ⟧T with ⟦ e ⟧T | ⟦ e' ⟧T
... | nat m | nat n = bool (dec2bool (m ≤? n))
⟦ ifE e then e' else e'' ⟧T with ⟦ e ⟧T
... | bool b = if b then ⟦ e' ⟧T else ⟦ e'' ⟧T
⌊_⌋ : {σ : Ty} → TExpr σ → Expr
⌊ nat n ⌋ = nat n
⌊ bool b ⌋ = bool b
⌊ e +E e' ⌋ = ⌊ e ⌋ +E ⌊ e' ⌋
⌊ e ≤E e' ⌋ = ⌊ e ⌋ ≤E ⌊ e' ⌋
⌊ ifE e then e' else e'' ⌋ = ifE ⌊ e ⌋ then ⌊ e' ⌋ else ⌊ e'' ⌋
_≡Ty?_ : (σ τ : Ty) → Dec (σ ≡ τ)
nat ≡Ty? nat = yes refl
nat ≡Ty? bool = no (λ ())
bool ≡Ty? nat = no (λ ())
bool ≡Ty? bool = yes refl
record Check (e : Expr) : Set where
constructor check
field
σ : Ty
te : TExpr σ
te≡e : ⌊ te ⌋ ≡ e
open Check
infer : (e : Expr) → Maybe (Check e)
infer (nat n) = just (check nat (nat n) refl)
infer (bool b) = just (check bool (bool b) refl)
infer (e +E e') with infer e | infer e'
infer (.(⌊ te ⌋) +E .(⌊ te' ⌋)) | just (check nat te refl) | just (check nat te' refl)
= just (check nat (te +E te') refl)
infer (e +E e') | _ | _ = nothing
infer (e ≤E e') with infer e | infer e'
infer (.(⌊ te ⌋) ≤E .(⌊ te' ⌋)) | just (check nat te refl) | just (check nat te' refl)
= just (check bool (te ≤E te') refl)
infer (e ≤E e') | _ | _ = nothing
infer (ifE e then e' else e'') with infer e | infer e' | infer e''
infer (ifE .(⌊ te ⌋) then .(⌊ te' ⌋) else .(⌊ te'' ⌋))
| just (check bool te refl) | just (check σ te' refl) | just (check σ' te'' refl) with σ ≡Ty? σ'
infer (ifE .(⌊ te ⌋) then .(⌊ te' ⌋) else .(⌊ te'' ⌋))
| just (check bool te refl) | just (check σ te' refl) | just (check .σ te'' refl) | yes refl
= just (check σ (ifE te then te' else te'') refl)
infer (ifE .(⌊ te ⌋) then .(⌊ te' ⌋) else .(⌊ te'' ⌋))
| just (check bool te refl) | just (check σ te' refl) | just (check σ' te'' refl) | no _ = nothing
infer (ifE e then e' else e'') | _ | _ | _ = nothing
⌊_⌋v : {σ : Ty} → TVal σ → Val
⌊ nat n ⌋v = nat n
⌊ bool b ⌋v = bool b
⟦_⟧s : Expr → Maybe Val
⟦ e ⟧s = infer e >>= λ c → return (⌊ ⟦ Check.te c ⟧T ⌋v)
v1' : Maybe Val
v1' = ⟦ e1 ⟧s
v2' : Maybe Val
v2' = ⟦ e2 ⟧s
v3' : Maybe Val
v3' = ⟦ e3 ⟧s