crosslang/golang-lean/GolangLean/Core/Eval.lean

import GolangLean.Core.Semantics

namespace GolangLean.Core

/-! # Executable evaluator and soundness.

A fuel-bounded recursive evaluator
  `eval : Nat → Heap → Env → Term → Option (Value × Heap)`
together with the soundness theorem
  `eval n h env e = some (v, h') → BigStep h env e v h'`.

Soundness is the bridge that makes the inductive specification *runnable*.
For any closed TGC term you can write a Lean theorem of the form
  `BigStep h env e v h'`
and prove it by `decide`-style execution: run `eval`, then apply
`eval_sound` to the equation. -/

def eval : Nat → Heap → Env → Term → Option (Value × Heap)
  | 0,     _, _,   _              => none
  | _ + 1, h, _,   .unitT         => some (.vUnit, h)
  | _ + 1, h, _,   .intLit k      => some (.vInt k, h)
  | _ + 1, h, _,   .boolLit b     => some (.vBool b, h)
  | _ + 1, h, env, .var x         =>
      match env.lookup x with
      | some v => some (v, h)
      | none   => none
  | _ + 1, h, env, .lam x body    => some (.vClos x body env, h)
  | n + 1, h, env, .app e1 e2     =>
      match eval n h env e1 with
      | some (.vClos x body env', h1) =>
          match eval n h1 env e2 with
          | some (v2, h2) => eval n h2 (env'.extend x v2) body
          | none          => none
      | _ => none
  | n + 1, h, env, .letIn x e1 e2 =>
      match eval n h env e1 with
      | some (v1, h1) => eval n h1 (env.extend x v1) e2
      | none          => none
  | n + 1, h, env, .ifte ec e1 e2 =>
      match eval n h env ec with
      | some (.vBool true,  h1) => eval n h1 env e1
      | some (.vBool false, h1) => eval n h1 env e2
      | _                        => none
  | n + 1, h, env, .binop op e1 e2 =>
      match eval n h env e1 with
      | some (v1, h1) =>
          match eval n h1 env e2 with
          | some (v2, h2) =>
              match op.apply v1 v2 with
              | some v => some (v, h2)
              | none   => none
          | none => none
      | none => none
  | n + 1, h, env, .refMk e       =>
      match eval n h env e with
      | some (v, h1) => some (.vLoc h1.size, h1.push v)
      | none         => none
  | n + 1, h, env, .deref e       =>
      match eval n h env e with
      | some (.vLoc loc, h1) =>
          match h1[loc]? with
          | some v => some (v, h1)
          | none   => none
      | _ => none
  | n + 1, h, env, .assign e1 e2  =>
      match eval n h env e1 with
      | some (.vLoc loc, h1) =>
          match eval n h1 env e2 with
          | some (v2, h2) =>
              if loc < h2.size then some (.vUnit, h2.set! loc v2) else none
          | none => none
      | _ => none
  | n + 1, h, env, .seq e1 e2     =>
      match eval n h env e1 with
      | some (_, h1) => eval n h1 env e2
      | none         => none

theorem eval_sound :
    ∀ (n : Nat) (h : Heap) (env : Env) (e : Term) (v : Value) (h' : Heap),
      eval n h env e = some (v, h') → BigStep h env e v h' := by
  intro n
  induction n with
  | zero =>
    intro h env e v h' heq
    simp [eval] at heq
  | succ n ih =>
    intro h env e v h' heq
    cases e with
    | unitT =>
      simp [eval] at heq
      obtain ⟨rfl, rfl⟩ := heq
      exact .unitR
    | intLit k =>
      simp [eval] at heq
      obtain ⟨rfl, rfl⟩ := heq
      exact .intLitR k
    | boolLit b =>
      simp [eval] at heq
      obtain ⟨rfl, rfl⟩ := heq
      exact .boolLitR b
    | var x =>
      simp only [eval] at heq
      split at heq
      next vv hL =>
        simp at heq
        obtain ⟨rfl, rfl⟩ := heq
        exact .varR hL
      next => simp at heq
    | lam x body =>
      simp [eval] at heq
      obtain ⟨rfl, rfl⟩ := heq
      exact .lamR x body
    | app e1 e2 =>
      simp only [eval] at heq
      split at heq
      next x body env' h1 heq1 =>
        split at heq
        next v2 h2 heq2 =>
          exact .appR (ih _ _ _ _ _ heq1) (ih _ _ _ _ _ heq2) (ih _ _ _ _ _ heq)
        next => simp at heq
      all_goals simp at heq
    | letIn x e1 e2 =>
      simp only [eval] at heq
      split at heq
      next v1 h1 heq1 =>
        exact .letInR (ih _ _ _ _ _ heq1) (ih _ _ _ _ _ heq)
      next => simp at heq
    | ifte ec e1 e2 =>
      simp only [eval] at heq
      split at heq
      next h1 heq1 =>
        exact .ifTR (ih _ _ _ _ _ heq1) (ih _ _ _ _ _ heq)
      next h1 heq1 =>
        exact .ifFR (ih _ _ _ _ _ heq1) (ih _ _ _ _ _ heq)
      all_goals simp at heq
    | binop op e1 e2 =>
      simp only [eval] at heq
      split at heq
      next v1 h1 heq1 =>
        split at heq
        next v2 h2 heq2 =>
          split at heq
          next vv heqop =>
            simp at heq
            obtain ⟨rfl, rfl⟩ := heq
            exact .binopR (ih _ _ _ _ _ heq1) (ih _ _ _ _ _ heq2) heqop
          next => simp at heq
        next => simp at heq
      next => simp at heq
    | refMk e =>
      simp only [eval] at heq
      split at heq
      next vv h1 heq1 =>
        simp at heq
        obtain ⟨rfl, rfl⟩ := heq
        exact .refMkR (ih _ _ _ _ _ heq1)
      next => simp at heq
    | deref e =>
      simp only [eval] at heq
      split at heq
      next loc h1 heq1 =>
        split at heq
        next vv hget =>
          simp at heq
          obtain ⟨rfl, rfl⟩ := heq
          exact .derefR (ih _ _ _ _ _ heq1) hget
        next => simp at heq
      all_goals simp at heq
    | assign e1 e2 =>
      simp only [eval] at heq
      split at heq
      next loc h1 heq1 =>
        split at heq
        next v2 h2 heq2 =>
          split at heq
          next hb =>
            simp at heq
            obtain ⟨rfl, rfl⟩ := heq
            exact .assignR (ih _ _ _ _ _ heq1) (ih _ _ _ _ _ heq2) hb
          next => simp at heq
        next => simp at heq
      all_goals simp at heq
    | seq e1 e2 =>
      simp only [eval] at heq
      split at heq
      next _ h1 heq1 =>
        exact .seqR (ih _ _ _ _ _ heq1) (ih _ _ _ _ _ heq)
      next => simp at heq

end GolangLean.Core