Skip to content

Commit 12618eb

Browse files
hyperpolymathhyperpolymathclaude
authored
feat(formal): grow P-2 to the STLC with functions + the substitution lemma (#629)
## What **P-2, Wave 1: the STLC with functions.** Adds what the first-order `P2_Progress.v` lacked — **functions, binders, and the substitution lemma**. Full **progress + preservation** for the simply-typed lambda calculus (base type `TUnit` + `→`), call-by-value, named (`nat`) variables. ## Axiom-free *and* funext-free The substitution lemma's abstraction case normally wants context equality (`update_shadow`/`update_permute`), which needs `functional_extensionality` — **an axiom**. This development avoids it entirely: contexts are compared only on a term's **free variables** (`free_in_context` + `context_invariance`), so it uses **no `functional_extensionality`** and `Print Assumptions` stays *"Closed under the global context"*. No `Admitted`. ## Contents `free_in_context` · `context_invariance` · **`subst_preserves_typing`** (the substitution lemma) · canonical forms · `progress` (induction on typing) · `preservation` (induction on the step relation). Discharges the `Siblings_Stated` P2 statements at the closed-term (empty-context) instantiation, as `P2_Progress.v` does. ## Scope (honest) Simply-typed only — the **QTT/affine quantities** (the substructural context-splitting discipline, the heart of "AffineScript is affine") are the remaining increment on top of this. ## Track status **10 files, 16 closure reports, zero axioms.** `P2_Progress.v` stays as the first-order seed; `P2_Stlc.v` is the grown STLC (the K1/K1Let, P3Sound/P3Graph pattern). `justfile`/`_CoqProject` build it; `.hypatia-ignore` extends the Coq-`.v`-isn't-V-lang carve-out; README + `PROOF-NEEDS.adoc` P-2 row updated. ```sh just -f formal/justfile check ``` 🤖 Generated with [Claude Code](https://claude.com/claude-code) https://claude.ai/code/session_01KPG9mEQXFyA3k7NWAzMNMr --- _Generated by [Claude Code](https://claude.ai/code/session_01KPG9mEQXFyA3k7NWAzMNMr)_ Co-authored-by: hyperpolymath <paraordinate@yahoo.co.uk> Co-authored-by: Claude Opus 4.8 <noreply@anthropic.com>
1 parent dd6c19e commit 12618eb

6 files changed

Lines changed: 228 additions & 8 deletions

File tree

.hypatia-ignore

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -61,3 +61,5 @@ cicd_rules/vlang_detected:formal/P2_Progress.v
6161
cicd_rules/banned_language_file:formal/P2_Progress.v
6262
cicd_rules/vlang_detected:formal/P3_BorrowGraph.v
6363
cicd_rules/banned_language_file:formal/P3_BorrowGraph.v
64+
cicd_rules/vlang_detected:formal/P2_Stlc.v
65+
cicd_rules/banned_language_file:formal/P2_Stlc.v

docs/PROOF-NEEDS.adoc

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -124,9 +124,10 @@ obligations. They are the "we might have missed" half of the brief.
124124
give `Step` its constructors and prove
125125
`progress`/`preservation`/`affinePreservation`.
126126
| XL | `partial`
127-
| #513 must-have 1; solo-core (Idris2) `stated`; **small-step progress +
128-
preservation mechanized** for a first-order nat/bool/`add`/`if` fragment in
129-
`formal/P2_Progress.v`
127+
| #513 must-have 1; solo-core (Idris2) `stated`; **progress + preservation
128+
mechanized** for a first-order fragment (`formal/P2_Progress.v`) AND for the
129+
**STLC with functions + the substitution lemma** (`formal/P2_Stlc.v`,
130+
funext-free). QTT/affine quantities are the remaining increment
130131

131132
| P-3
132133
| **Borrow-graph soundness.** A well-typed program never observes a moved/aliased

formal/P2_Stlc.v

Lines changed: 206 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,206 @@
1+
(* SPDX-License-Identifier: MPL-2.0 *)
2+
(* SPDX-FileCopyrightText: 2026 Jonathan D.A. Jewell (hyperpolymath) *)
3+
4+
(*
5+
P2_Stlc.v
6+
═════════
7+
P-2, GROWN (Wave 1). Adds what the first-order P2_Progress.v lacked:
8+
**functions, binders, and the substitution lemma**. Full progress +
9+
preservation for the simply-typed lambda calculus (base type `TUnit` plus
10+
`→`), call-by-value, named (`nat`) variables.
11+
12+
Crucially **funext-free**: contexts are compared only on a term's *free*
13+
variables (`context_invariance`), never by function equality — so the
14+
development uses NO `functional_extensionality` and `Print Assumptions` stays
15+
"Closed under the global context". No `Admitted`, no axioms.
16+
17+
Scope: simply-typed (no QTT/affine quantities yet) — the substructural
18+
context-splitting discipline on top of this is the next increment.
19+
20+
`.v` is Coq, not V-lang — see formal/README.adoc and .hypatia-ignore.
21+
*)
22+
23+
Require Import PeanoNat.
24+
Require Import ASFormal.Siblings_Stated.
25+
26+
Definition id := nat.
27+
28+
Inductive ty := TUnit | TArrow (A B : ty).
29+
30+
Inductive tm :=
31+
| var (x : id)
32+
| app (f a : tm)
33+
| abs (x : id) (A : ty) (b : tm) (* A is the domain type *)
34+
| tunit.
35+
36+
Inductive value : tm -> Prop :=
37+
| v_abs : forall x A b, value (abs x A b)
38+
| v_unit : value tunit.
39+
40+
(* Substitution. Only ever applied with a closed value (the beta-redex
41+
argument), so capture cannot arise — established by the typing lemmas. *)
42+
Fixpoint subst (x : id) (s t : tm) : tm :=
43+
match t with
44+
| var y => if Nat.eqb x y then s else var y
45+
| abs y A b => abs y A (if Nat.eqb x y then b else subst x s b)
46+
| app f a => app (subst x s f) (subst x s a)
47+
| tunit => tunit
48+
end.
49+
50+
Inductive step : tm -> tm -> Prop :=
51+
| ST_AppAbs : forall x A b v, value v -> step (app (abs x A b) v) (subst x v b)
52+
| ST_App1 : forall f f' a, step f f' -> step (app f a) (app f' a)
53+
| ST_App2 : forall f a a', value f -> step a a' -> step (app f a) (app f a').
54+
55+
Definition context := id -> option ty.
56+
Definition empty : context := fun _ => None.
57+
Definition extend (G : context) (x : id) (T : ty) : context :=
58+
fun y => if Nat.eqb x y then Some T else G y.
59+
60+
Inductive has_type : context -> tm -> ty -> Prop :=
61+
| T_Var : forall G x T, G x = Some T -> has_type G (var x) T
62+
| T_Abs : forall G x A B b, has_type (extend G x A) b B -> has_type G (abs x A b) (TArrow A B)
63+
| T_App : forall G f a A B, has_type G f (TArrow A B) -> has_type G a A -> has_type G (app f a) B
64+
| T_Unit : forall G, has_type G tunit TUnit.
65+
66+
(* ── free variables, free-in-context ───────────────────────────────────── *)
67+
68+
Inductive afi : id -> tm -> Prop :=
69+
| afi_var : forall x, afi x (var x)
70+
| afi_app1 : forall x f a, afi x f -> afi x (app f a)
71+
| afi_app2 : forall x f a, afi x a -> afi x (app f a)
72+
| afi_abs : forall x y A b, y <> x -> afi x b -> afi x (abs y A b).
73+
74+
#[local] Hint Constructors afi : core.
75+
76+
Lemma free_in_context : forall x t S G,
77+
afi x t -> has_type G t S -> exists U, G x = Some U.
78+
Proof.
79+
intros x t S G Hafi; generalize dependent S; generalize dependent G.
80+
induction Hafi; intros G S HT; inversion HT; subst.
81+
- eauto.
82+
- eapply IHHafi; eauto.
83+
- eapply IHHafi; eauto.
84+
- edestruct IHHafi as [U HU]; eauto.
85+
unfold extend in HU. destruct (Nat.eqb y x) eqn:E.
86+
+ apply Nat.eqb_eq in E; subst y; exfalso; apply H; reflexivity.
87+
+ eauto.
88+
Qed.
89+
90+
Corollary typable_empty_closed : forall x t S,
91+
afi x t -> has_type empty t S -> False.
92+
Proof.
93+
intros x t S Hafi HT.
94+
destruct (free_in_context x t S empty Hafi HT) as [U HU]; discriminate HU.
95+
Qed.
96+
97+
(* ── context invariance (the funext-free substitute for map equality) ──── *)
98+
99+
Lemma context_invariance : forall G G' t S,
100+
has_type G t S ->
101+
(forall x, afi x t -> G x = G' x) ->
102+
has_type G' t S.
103+
Proof.
104+
intros G G' t S HT; generalize dependent G'.
105+
induction HT; intros G' Hf.
106+
- apply T_Var. rewrite <- (Hf x (afi_var x)). assumption.
107+
- apply T_Abs. apply IHHT. intros z Hz. unfold extend.
108+
destruct (Nat.eqb x z) eqn:E; auto.
109+
apply Hf. apply Nat.eqb_neq in E. auto.
110+
- eapply T_App; [apply IHHT1 | apply IHHT2]; intros z Hz; apply Hf; auto.
111+
- apply T_Unit.
112+
Qed.
113+
114+
(* ── substitution preserves typing ─────────────────────────────────────── *)
115+
116+
Lemma subst_preserves_typing : forall G x U t v S,
117+
has_type (extend G x U) t S ->
118+
has_type empty v U ->
119+
has_type G (subst x v t) S.
120+
Proof.
121+
intros G x U t v S Ht Hv; generalize dependent S; generalize dependent G.
122+
induction t as [ y | f IHf a IHa | y A b IHb | ];
123+
intros G S Ht; simpl; inversion Ht; subst.
124+
- (* var y *)
125+
unfold extend in H1. destruct (Nat.eqb x y) eqn:E.
126+
+ injection H1 as H1. rewrite <- H1.
127+
apply (context_invariance empty G); [assumption |].
128+
intros z Hz. exfalso; apply (typable_empty_closed z v U Hz Hv).
129+
+ apply T_Var; assumption.
130+
- (* app f a *)
131+
eapply T_App; [apply IHf | apply IHa]; eassumption.
132+
- (* abs y A b *)
133+
destruct (Nat.eqb x y) eqn:E.
134+
+ apply Nat.eqb_eq in E; subst y.
135+
apply T_Abs.
136+
apply (context_invariance (extend (extend G x U) x A) (extend G x A));
137+
[assumption |].
138+
intros z Hz. unfold extend. destruct (Nat.eqb x z); reflexivity.
139+
+ apply T_Abs. apply IHb.
140+
apply (context_invariance (extend (extend G x U) y A)
141+
(extend (extend G y A) x U)); [assumption |].
142+
intros z Hz. unfold extend.
143+
destruct (Nat.eqb y z) eqn:E1; destruct (Nat.eqb x z) eqn:E2;
144+
try reflexivity.
145+
exfalso. apply Nat.eqb_neq in E. apply E.
146+
apply Nat.eqb_eq in E1; apply Nat.eqb_eq in E2.
147+
rewrite E2, <- E1; reflexivity.
148+
- (* tunit *) apply T_Unit.
149+
Qed.
150+
151+
(* ── canonical forms ───────────────────────────────────────────────────── *)
152+
153+
Lemma canon_arrow : forall v A B,
154+
value v -> has_type empty v (TArrow A B) -> exists x b, v = abs x A b.
155+
Proof.
156+
intros v A B Hv HT; destruct Hv.
157+
- inversion HT; subst; eauto.
158+
- inversion HT.
159+
Qed.
160+
161+
(* ── progress ──────────────────────────────────────────────────────────── *)
162+
163+
Theorem progress : forall t S, has_type empty t S -> value t \/ exists t', step t t'.
164+
Proof.
165+
intros t S HT; remember empty as G eqn:HG.
166+
induction HT.
167+
- subst G; discriminate H.
168+
- left; apply v_abs.
169+
- right; subst G.
170+
destruct IHHT1 as [Hvf | [f' Hf]]; [reflexivity | |].
171+
+ destruct (canon_arrow _ _ _ Hvf HT1) as [x [b ->]].
172+
destruct IHHT2 as [Hva | [a' Ha]]; [reflexivity | |].
173+
* eexists; apply ST_AppAbs; assumption.
174+
* eexists; apply ST_App2; [apply v_abs | eassumption].
175+
+ eexists; apply ST_App1; eassumption.
176+
- left; apply v_unit.
177+
Qed.
178+
179+
(* ── preservation ──────────────────────────────────────────────────────── *)
180+
181+
Theorem preservation : forall t t' S,
182+
has_type empty t S -> step t t' -> has_type empty t' S.
183+
Proof.
184+
intros t t' S HT Hstep; generalize dependent S.
185+
induction Hstep; intros S HT; inversion HT; subst.
186+
- (* ST_AppAbs *)
187+
match goal with H : has_type _ (abs _ _ _) _ |- _ => inversion H; subst end.
188+
eapply subst_preserves_typing; eassumption.
189+
- (* ST_App1 *) eapply T_App; [ apply IHHstep; eassumption | eassumption ].
190+
- (* ST_App2 *) eapply T_App; [ eassumption | apply IHHstep; eassumption ].
191+
Qed.
192+
193+
(* ── discharge the stated obligations (closed-term, ctx:=unit) ──────────── *)
194+
195+
Definition P2_progress_discharged
196+
: P2_progress tm ty unit tt
197+
(fun (_ : unit) (t : tm) (T : ty) => has_type empty t T) value step
198+
:= progress.
199+
200+
Definition P2_preservation_discharged
201+
: P2_preservation tm ty unit
202+
(fun (_ : unit) (t : tm) (T : ty) => has_type empty t T) step
203+
:= fun (_ : unit) t t' T HT Hs => preservation t t' T HT Hs.
204+
205+
Print Assumptions progress.
206+
Print Assumptions preservation.

formal/README.adoc

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,12 @@ cannot mistake it. Coq has no `v.mod` manifest, so `vmod_detected` never fires.
4545
| **stated** — and now discharged for concrete models below
4646

4747
| `P2_Progress.v`
48-
| **P-2** — progress + preservation (nat/bool/`add`/`if`, small-step)
48+
| **P-2** — progress + preservation (nat/bool/`add`/`if`, first-order)
49+
| **mechanized**, axiom-free
50+
51+
| `P2_Stlc.v`
52+
| **P-2, grown** — STLC with *functions* + the substitution lemma; progress +
53+
preservation (funext-free)
4954
| **mechanized**, axiom-free
5055

5156
| `P3_BorrowSound.v`
@@ -82,9 +87,14 @@ the stated obligation and pin its meaning, not the full language:
8287

8388
* **P-2** (`P2_Progress.v`) — a simply-typed first-order calculus
8489
(nat/bool/`add`/`if`), small-step, call-by-value, with the standard
85-
canonical-forms / progress / preservation development. Functions, binders,
86-
products/sums and the QTT quantities are the next increments (codegen
87-
preservation *with* `let`/variables is already in `K1Let_…`).
90+
canonical-forms / progress / preservation development.
91+
* **P-2, grown** (`P2_Stlc.v`) — the Wave-1 increment: the **simply-typed
92+
lambda calculus** with functions, binders, and the **substitution lemma**
93+
(the thing the first-order version lacked). Full progress + preservation,
94+
**funext-free** — contexts are compared only on a term's *free* variables
95+
(`context_invariance`), so it uses no `functional_extensionality` and stays
96+
axiom-free. The QTT/affine quantities (substructural context splitting) are
97+
the next increment.
8898
* **P-3** (`P3_BorrowSound.v`) — a one-resource borrow calculus; proves the
8999
precise validity checker is sound and **rejects the #554 witness**
90100
(`[OBorrow; OMove; OUseRef]`), matching `lib/borrow.ml`'s post-#554-fix

formal/_CoqProject

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,3 +8,4 @@ F4_ErrorFaithful.v
88
P3_BorrowSound.v
99
P3_BorrowGraph.v
1010
P2_Progress.v
11+
P2_Stlc.v

formal/justfile

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ check:
1111
all=""
1212
for f in K1_CodegenPreservation K1Let_CodegenPreservation Siblings_Stated \
1313
F1_TransformerPreservation F3_PragmaDecidable F4_ErrorFaithful \
14-
P3_BorrowSound P3_BorrowGraph P2_Progress; do
14+
P3_BorrowSound P3_BorrowGraph P2_Progress P2_Stlc; do
1515
echo "== coqc $f.v =="
1616
o="$(coqc -Q . ASFormal "$f.v")"
1717
printf '%s\n' "$o"

0 commit comments

Comments
 (0)