d86d500b4f
OctiveLean/Core/Preservation.lean — the TOC analogue of TGC's
preservation. Statement:
HasType Γ e T ∧ HasTypeEnv env Γ ∧ BigStep env e v env'
⟹ HasTypeV v T ∧ HasTypeEnv env' Γ
No heap-typing extension (Octave has no heap). Γ is unchanged across
big-steps (assign requires x already typed).
Three structural changes were required to make preservation provable
under env-mutation, all small:
* letIn semantics shifted to scope-restoring: BigStep.letInR now
returns env1 (the env after evaluating the bound expression)
rather than env2 (after the body). This drops body's mutations
at scope-end, matching the lambda-calculus tradition. Determinism
and Eval updated to match.
* HasTypeV.vClos uses a two-part premise (he_dom + he_typed)
instead of nested ∃ — the kernel rejects nested inductive
parameters with locally-bound vars. The two parts are equivalent
to HasTypeEnv via the new HasTypeV.vClos_to_env inversion lemma.
* Inversion via HasTypeV.vClos_to_env exposes the closure's typing
context as an existential — preservation's appR case uses this
to construct the body's HasTypeEnv via extend_letIn.
The cross-language symmetry that emerged:
TGC preservation : threads heap-typings, weakens via extension.
TOC preservation : threads env directly, no extension needed.
In both, the rule cases collapse into the same three structural
shapes — terminal, IH-chain, contradiction-collapse. The case bodies
differ in HOW state is propagated (heap-typing for TGC, env for TOC)
but the SHAPE of each case is identical. That's the cross-language
abstraction speaking.
Zero sorries / axioms / admits across both projects.
173 lines
5.9 KiB
Text
173 lines
5.9 KiB
Text
import OctiveLean.Core.Semantics
|
||
|
||
namespace OctiveLean.Core
|
||
|
||
/-! # Executable evaluator and soundness for TOC.
|
||
|
||
Fuel-bounded recursive evaluator
|
||
`eval : Nat → Env → Term → Option (Value × Env)`
|
||
together with
|
||
`eval_sound : eval n env e = some (v, env') → BigStep env e v env'`.
|
||
|
||
Function-call semantics: the body's post-env is *discarded* — only the
|
||
arg-evaluation env propagates outward. This matches Octave/MATLAB scoping
|
||
where mutations inside a function do not leak.
|
||
|
||
`whileT` recursion uses one fuel step per iteration. A run that uses `n`
|
||
fuel covers up to `n` iterations of the loop. -/
|
||
|
||
def eval : Nat → Env → Term → Option (Value × Env)
|
||
| 0, _, _ => none
|
||
| _ + 1, env, .unitT => some (.vUnit, env)
|
||
| _ + 1, env, .intLit k => some (.vInt k, env)
|
||
| _ + 1, env, .boolLit b => some (.vBool b, env)
|
||
| _ + 1, env, .var x =>
|
||
match env.lookup x with
|
||
| some v => some (v, env)
|
||
| none => none
|
||
| _ + 1, env, .lam x body => some (.vClos x body env, env)
|
||
| n + 1, env, .app e1 e2 =>
|
||
match eval n env e1 with
|
||
| some (.vClos x body env_clos, env1) =>
|
||
match eval n env1 e2 with
|
||
| some (v_arg, env2) =>
|
||
match eval n (env_clos.extend x v_arg) body with
|
||
| some (v, _) => some (v, env2)
|
||
| none => none
|
||
| none => none
|
||
| _ => none
|
||
| n + 1, env, .letIn x e1 e2 =>
|
||
match eval n env e1 with
|
||
| some (v1, env1) =>
|
||
match eval n (env1.extend x v1) e2 with
|
||
| some (v2, _) => some (v2, env1) -- scope-restore: discard body's post-env
|
||
| none => none
|
||
| none => none
|
||
| n + 1, env, .ifte ec e1 e2 =>
|
||
match eval n env ec with
|
||
| some (.vBool true, env1) => eval n env1 e1
|
||
| some (.vBool false, env1) => eval n env1 e2
|
||
| _ => none
|
||
| n + 1, env, .binop op e1 e2 =>
|
||
match eval n env e1 with
|
||
| some (v1, env1) =>
|
||
match eval n env1 e2 with
|
||
| some (v2, env2) =>
|
||
match op.apply v1 v2 with
|
||
| some v => some (v, env2)
|
||
| none => none
|
||
| none => none
|
||
| none => none
|
||
| n + 1, env, .seq e1 e2 =>
|
||
match eval n env e1 with
|
||
| some (_, env1) => eval n env1 e2
|
||
| none => none
|
||
| n + 1, env, .assign x e =>
|
||
match eval n env e with
|
||
| some (v, env1) => some (.vUnit, env1.extend x v)
|
||
| none => none
|
||
| n + 1, env, .whileT c b =>
|
||
match eval n env c with
|
||
| some (.vBool true, env1) =>
|
||
match eval n env1 b with
|
||
| some (_, env2) => eval n env2 (.whileT c b)
|
||
| none => none
|
||
| some (.vBool false, env1) => some (.vUnit, env1)
|
||
| _ => none
|
||
|
||
theorem eval_sound :
|
||
∀ (n : Nat) (env : Env) (e : Term) (v : Value) (env' : Env),
|
||
eval n env e = some (v, env') → BigStep env e v env' := by
|
||
intro n
|
||
induction n with
|
||
| zero => intro env e v env' heq; simp [eval] at heq
|
||
| succ n ih =>
|
||
intro env e v env' 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_clos env1 heq1 =>
|
||
split at heq
|
||
next v_arg env2 heq2 =>
|
||
split at heq
|
||
next v_body _ heqb =>
|
||
simp at heq; obtain ⟨rfl, rfl⟩ := heq
|
||
exact .appR (ih _ _ _ _ heq1) (ih _ _ _ _ heq2) (ih _ _ _ _ heqb)
|
||
next => simp at heq
|
||
next => simp at heq
|
||
all_goals simp at heq
|
||
| letIn x e1 e2 =>
|
||
simp only [eval] at heq
|
||
split at heq
|
||
next v1 env1 heq1 =>
|
||
split at heq
|
||
next v2 _ heq2 =>
|
||
simp at heq; obtain ⟨rfl, rfl⟩ := heq
|
||
exact .letInR (ih _ _ _ _ heq1) (ih _ _ _ _ heq2)
|
||
next => simp at heq
|
||
next => simp at heq
|
||
| ifte ec e1 e2 =>
|
||
simp only [eval] at heq
|
||
split at heq
|
||
next env1 heq1 => exact .ifTR (ih _ _ _ _ heq1) (ih _ _ _ _ heq)
|
||
next env1 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 env1 heq1 =>
|
||
split at heq
|
||
next v2 env2 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
|
||
| seq e1 e2 =>
|
||
simp only [eval] at heq
|
||
split at heq
|
||
next _ env1 heq1 =>
|
||
exact .seqR (ih _ _ _ _ heq1) (ih _ _ _ _ heq)
|
||
next => simp at heq
|
||
| assign x e =>
|
||
simp only [eval] at heq
|
||
split at heq
|
||
next vv env1 heq1 =>
|
||
simp at heq; obtain ⟨rfl, rfl⟩ := heq
|
||
exact .assignR (ih _ _ _ _ heq1)
|
||
next => simp at heq
|
||
| whileT c b =>
|
||
simp only [eval] at heq
|
||
split at heq
|
||
next env1 heq1 =>
|
||
split at heq
|
||
next _ env2 heq2 =>
|
||
have hbs_rec := ih _ _ _ _ heq
|
||
have hv_unit : v = .vUnit := by cases hbs_rec <;> rfl
|
||
subst hv_unit
|
||
exact .whileTR (ih _ _ _ _ heq1) (ih _ _ _ _ heq2) hbs_rec
|
||
next => simp at heq
|
||
next env1 heq1 =>
|
||
simp at heq; obtain ⟨rfl, rfl⟩ := heq
|
||
exact .whileFR (ih _ _ _ _ heq1)
|
||
all_goals simp at heq
|
||
|
||
end OctiveLean.Core
|