-- Frap/Types.lean

import Frap.SmallStep

namespace TM

inductive Tm : Type :=
  | tru : Tm
  | fls : Tm
  | ite : Tm → Tm → Tm → Tm
  | zro : Tm
  | scc : Tm → Tm
  | prd : Tm → Tm
  | iszero : Tm → Tm

open Tm

inductive BValue : Tm → Prop :=
  | bv_true : BValue tru
  | bv_false : BValue fls

inductive NValue : Tm → Prop :=
  | nv_0 : NValue zro
  | nv_succ t : NValue t → NValue (scc t)

open BValue

open NValue

abbrev value (t : Tm) := BValue t ∨ NValue t

inductive Step : Tm → Tm → Prop :=
  | st_ifTrue t₁ t₂ : Step (ite tru t₁ t₂) t₁
  | st_ifFalse t₁ t₂ : Step (ite fls t₁ t₂) t₂
  | st_if c c' t₁ t₂ :
      Step c c' → Step (ite c t₁ t₂) (ite c' t₁ t₂)
  | st_succ t₁ t₁' : Step t₁ t₁' → Step (scc t₁) (scc t₁')
  | st_pred0 : Step (prd zro) zro
  | st_predSucc v : NValue v → Step (prd (scc v)) v
  | st_pred t₁ t₁' : Step t₁ t₁' → Step (prd t₁) (prd t₁')
  | st_iszero0 : Step (iszero zro) tru
  | st_iszeroSucc v : NValue v → Step (iszero (scc v)) fls
  | st_iszero t₁ t₁' :
      Step t₁ t₁' → Step (iszero t₁) (iszero t₁')

open Step

abbrev step_normal_form := normal_form Step

def stuck (t: Tm) : Prop :=
  step_normal_form t ∧ ¬ value t

/-
exercise (2-star)
-/
example : ∃ t, stuck t :=

inductive Ty : Type :=
  | bool : Ty
  | nat : Ty

open Ty

inductive HasType : Tm → Ty → Prop :=
  | t_true : HasType tru bool
  | t_false : HasType fls bool
  | t_if t₁ t₂ t₃ T :
      HasType t₁ bool → HasType t₂ T → HasType t₃ T
      → HasType (ite t₁ t₂ t₃) T
  | t_0 : HasType zro nat
  | t_succ t₁ : HasType t₁ nat → HasType (scc t₁) nat
  | t_pred t₁ : HasType t₁ nat → HasType (prd t₁) nat
  | t_iszero t₁ : HasType t₁ nat → HasType (iszero t₁) bool

open HasType

example  -- `⊢ if false then 0 else (succ 0) ∈ nat`
    : HasType (ite fls zro (scc zro)) nat := by
  apply t_if
  . apply t_false
  . apply t_0
  . apply t_succ
    apply t_0

/-
It's important to realize that the typing relation is a _conservative_ (or _static_) approximation: it does not consider what happens when the term is reduced.
In particular, it does not calculate the type of its normal form.
-/

example  -- `⊢ if false then zero else true ∉ bool`
    : ¬ HasType (ite fls zro tru) bool := by
  intro contra
  cases contra
  rename_i contra _
  cases contra

/-
exercise (1-star)
-/
example t : HasType (scc t) nat → HasType t nat := by
  intro ht
  cases ht
  assumption

abbrev multistep := Multi Step

-- Repository definitions used:
content: syntax term "==>" term : term

syntax term "~~>" term : term

syntax term "~~>*" term : term

syntax:30 term " =[ " imp " ]=> " term : term

syntax term "!->" term "; " term : term

syntax:36 term "<<->>" term : term

content: macro_rules
  | `(term|$t:term ==> $n:term) => `(Eval $t $n)

content: macro_rules
  | `(term|$t₁:term ~~> $t₂:term) => `(Step $t₁ $t₂)

example :
    p
      (p (c 1) (c 3))
      (p (c 2) (c 4))
    ~~>
    p
      (c 4)
      (p (c 2) (c 4)) := by admit /- proof elided -/

content: macro_rules
  | `(term|$t₁:term ~~>* $t₂:term) => `(Multi Step $t₁ $t₂)

content: macro_rules
  | `(term|$p <<->> $q) => `($p ->> $q ∧ $q ->> $p)

content: macro_rules
  | `(term|{*$p*} $c {*$q*}) => `(valid_hoare_triple $p $c $q)

content: macro_rules
  | `(term|$st =[ $c ]=> $st') => `(CEval <{$c}> $st $st')

content: macro_rules
  | `(term|$x:term !-> $a:term ; $st) => `(update $st $x $a)

example : empty =[
      x := 2;
      if (x <= 1) then y := 3 else z := 4 end
    ]=> (z !-> 4; x !-> 2; empty) := by admit /- proof elided -/

content: inductive Tm : Type :=
  | tru : Tm
  | fls : Tm
  | ite : Tm → Tm → Tm → Tm
  | zro : Tm
  | scc : Tm → Tm
  | prd : Tm → Tm
  | iszero : Tm → Tm

content: inductive Step : Tm → Tm → Prop :=
  | st_ifTrue t₁ t₂ : Step (ite tru t₁ t₂) t₁
  | st_ifFalse t₁ t₂ : Step (ite fls t₁ t₂) t₂
  | st_if c c' t₁ t₂ :
      Step c c' → Step (ite c t₁ t₂) (ite c' t₁ t₂)
  | st_succ t₁ t₁' : Step t₁ t₁' → Step (scc t₁) (scc t₁')
  | st_pred0 : Step (prd zro) zro
  | st_predSucc v : NValue v → Step (prd (scc v)) v
  | st_pred t₁ t₁' : Step t₁ t₁' → Step (prd t₁) (prd t₁')
  | st_iszero0 : Step (iszero zro) tru
  | st_iszeroSucc v : NValue v → Step (iszero (scc v)) fls
  | st_iszero t₁ t₁' :
      Step t₁ t₁' → Step (iszero t₁) (iszero t₁')

content: inductive NValue : Tm → Prop :=
  | nv_0 : NValue zro
  | nv_succ t : NValue t → NValue (scc t)

content: inductive Tm : Type :=
  | c : Nat → Tm       
  | p : Tm → Tm → Tm   

content: def normal_form {X : Type} (R : relation X) (t : X) : Prop := ¬∃t', R t t'

content: def relation (X : Type) := X → X → Prop

content: inductive BValue : Tm → Prop :=
  | bv_true : BValue tru
  | bv_false : BValue fls

content: inductive And : Prop → Prop → Prop where
  | intro : a → b → And a b

content: inductive Ty : Type :=
  | bool : Ty
  | nat : Ty

content: inductive HasType : Tm → Ty → Prop :=
  | t_true : HasType tru bool
  | t_false : HasType fls bool
  | t_if t₁ t₂ t₃ T :
      HasType t₁ bool → HasType t₂ T → HasType t₃ T
      → HasType (ite t₁ t₂ t₃) T
  | t_0 : HasType zro nat
  | t_succ t₁ : HasType t₁ nat → HasType (scc t₁) nat
  | t_pred t₁ : HasType t₁ nat → HasType (prd t₁) nat
  | t_iszero t₁ : HasType t₁ nat → HasType (iszero t₁) bool

content: inductive Multi {X : Type} (R : relation X) : relation X :=
  | multi_refl x : Multi R x x
  | multi_step x y z : R x y → Multi R y z → Multi R x z

-- Repository lemmas used:
content: theorem List.getElem_append_left{α : Type u_1} {l₁ l₂ : List α} {i : Nat} (hn : i < l₁.length) :\n(l₁ ++ l₂)[i] = l₁[i]

-- Local definitions used:
content: inductive Tm : Type :=
  | tru : Tm
  | fls : Tm
  | ite : Tm → Tm → Tm → Tm
  | zro : Tm
  | scc : Tm → Tm
  | prd : Tm → Tm
  | iszero : Tm → Tm

content: inductive BValue : Tm → Prop :=
  | bv_true : BValue tru
  | bv_false : BValue fls

content: inductive NValue : Tm → Prop :=
  | nv_0 : NValue zro
  | nv_succ t : NValue t → NValue (scc t)

content: abbrev value (t : Tm) := BValue t ∨ NValue t

content: inductive Step : Tm → Tm → Prop :=
  | st_ifTrue t₁ t₂ : Step (ite tru t₁ t₂) t₁
  | st_ifFalse t₁ t₂ : Step (ite fls t₁ t₂) t₂
  | st_if c c' t₁ t₂ :
      Step c c' → Step (ite c t₁ t₂) (ite c' t₁ t₂)
  | st_succ t₁ t₁' : Step t₁ t₁' → Step (scc t₁) (scc t₁')
  | st_pred0 : Step (prd zro) zro
  | st_predSucc v : NValue v → Step (prd (scc v)) v
  | st_pred t₁ t₁' : Step t₁ t₁' → Step (prd t₁) (prd t₁')
  | st_iszero0 : Step (iszero zro) tru
  | st_iszeroSucc v : NValue v → Step (iszero (scc v)) fls
  | st_iszero t₁ t₁' :
      Step t₁ t₁' → Step (iszero t₁) (iszero t₁')

content: abbrev step_normal_form := normal_form Step

content: def stuck (t: Tm) : Prop :=
  step_normal_form t ∧ ¬ value t

/-
exercise (2-star)
-/
example : ∃ t, stuck t :=

content: inductive Ty : Type :=
  | bool : Ty
  | nat : Ty

content: inductive HasType : Tm → Ty → Prop :=
  | t_true : HasType tru bool
  | t_false : HasType fls bool
  | t_if t₁ t₂ t₃ T :
      HasType t₁ bool → HasType t₂ T → HasType t₃ T
      → HasType (ite t₁ t₂ t₃) T
  | t_0 : HasType zro nat
  | t_succ t₁ : HasType t₁ nat → HasType (scc t₁) nat
  | t_pred t₁ : HasType t₁ nat → HasType (prd t₁) nat
  | t_iszero t₁ : HasType t₁ nat → HasType (iszero t₁) bool

content: abbrev multistep := Multi Step

-- Local lemmas used:
content: theorem bool_canonical t : HasType t bool → value t → BValue t

content: theorem nat_canonical t : HasType t nat → value t → NValue t

content: theorem progress t T
    : HasType t T → value t ∨ ∃ t', Step t t'

content: theorem preservation t t' T
    : HasType t T → Step t t' → HasType t' T

-- Target theorem and proof:
theorem soundness t t' T
    : HasType t T → multistep t t' → ¬ stuck t'
:= by
  intro hT P
  induction P with (intro contra; obtain ⟨R, S⟩ := contra)
  | multi_refl =>
    cases (progress _ _ hT)
    . -- value
      simp [*] at *
    . -- step
      simp [step_normal_form, normal_form, *] at *
  | multi_step =>
    rename_i ih; apply ih
    . apply preservation
      . apply hT
      . assumption
    . unfold stuck; constructor <;> assumption