|
| 1 | +(* SPDX-License-Identifier: MPL-2.0 *) |
| 2 | +(* SPDX-FileCopyrightText: 2026 Jonathan D.A. Jewell (hyperpolymath) *) |
| 3 | + |
| 4 | +(* |
| 5 | + P2_Progress.v |
| 6 | + ═════════════ |
| 7 | + Mechanizes obligation **P-2** (progress + preservation) for a minimal typed |
| 8 | + calculus, discharging both statements from Siblings_Stated.v — axiom-free, |
| 9 | + no Admitted. |
| 10 | +
|
| 11 | + Calculus: types Nat | Bool; terms numbers, booleans, `add`, and `if` (a real |
| 12 | + elimination form, so progress is non-trivial — a `tif` on a non-boolean is |
| 13 | + ruled out only by typing). Small-step, call-by-value. This is the classic |
| 14 | + "arith + bool" type-soundness core. |
| 15 | +
|
| 16 | + Scope (honest): this is the *simply-typed, first-order* core of the Solo |
| 17 | + fragment. Functions/`let`/binders (substitution or environments), products, |
| 18 | + sums, and the QTT/affine quantities are the next increments — solo-core's |
| 19 | + Duet/Ensemble direction. (Codegen preservation WITH `let`/variables is |
| 20 | + already mechanized in K1Let_CodegenPreservation.v.) |
| 21 | +
|
| 22 | + `.v` is Coq, not V-lang — see formal/README.adoc and .hypatia-ignore. |
| 23 | +*) |
| 24 | + |
| 25 | +Require Import ASFormal.Siblings_Stated. |
| 26 | + |
| 27 | +Inductive ty := TNat | TBool. |
| 28 | + |
| 29 | +Inductive tm := |
| 30 | +| tnum (n : nat) |
| 31 | +| tbool (b : bool) |
| 32 | +| tadd (a b : tm) |
| 33 | +| tif (c t e : tm). |
| 34 | + |
| 35 | +Inductive value : tm -> Prop := |
| 36 | +| v_num : forall n, value (tnum n) |
| 37 | +| v_bool : forall b, value (tbool b). |
| 38 | + |
| 39 | +Inductive has_type : tm -> ty -> Prop := |
| 40 | +| T_Num : forall n, has_type (tnum n) TNat |
| 41 | +| T_Bool : forall b, has_type (tbool b) TBool |
| 42 | +| T_Add : forall a b, has_type a TNat -> has_type b TNat -> has_type (tadd a b) TNat |
| 43 | +| T_If : forall c t e T, |
| 44 | + has_type c TBool -> has_type t T -> has_type e T -> has_type (tif c t e) T. |
| 45 | + |
| 46 | +Inductive step : tm -> tm -> Prop := |
| 47 | +| S_Add1 : forall a a' b, step a a' -> step (tadd a b) (tadd a' b) |
| 48 | +| S_Add2 : forall a b b', value a -> step b b' -> step (tadd a b) (tadd a b') |
| 49 | +| S_AddNum : forall m n, step (tadd (tnum m) (tnum n)) (tnum (m + n)) |
| 50 | +| S_If : forall c c' t e, step c c' -> step (tif c t e) (tif c' t e) |
| 51 | +| S_IfTrue : forall t e, step (tif (tbool true) t e) t |
| 52 | +| S_IfFalse : forall t e, step (tif (tbool false) t e) e. |
| 53 | + |
| 54 | +(* ── canonical forms ───────────────────────────────────────────────────── *) |
| 55 | + |
| 56 | +Lemma canon_nat : forall v, value v -> has_type v TNat -> exists n, v = tnum n. |
| 57 | +Proof. intros v Hv HT; inversion Hv; subst; inversion HT; subst; eauto. Qed. |
| 58 | + |
| 59 | +Lemma canon_bool : forall v, value v -> has_type v TBool -> exists b, v = tbool b. |
| 60 | +Proof. intros v Hv HT; inversion Hv; subst; inversion HT; subst; eauto. Qed. |
| 61 | + |
| 62 | +(* ── progress ──────────────────────────────────────────────────────────── *) |
| 63 | + |
| 64 | +Theorem progress : forall t T, has_type t T -> value t \/ (exists t', step t t'). |
| 65 | +Proof. |
| 66 | + intros t T HT; induction HT. |
| 67 | + - left; constructor. |
| 68 | + - left; constructor. |
| 69 | + - (* tadd a b *) |
| 70 | + right; destruct IHHT1 as [Hva | [a' Ha]]. |
| 71 | + + destruct (canon_nat a Hva HT1) as [m ->]. |
| 72 | + destruct IHHT2 as [Hvb | [b' Hb]]. |
| 73 | + * destruct (canon_nat b Hvb HT2) as [n ->]; eauto using S_AddNum. |
| 74 | + * eauto using S_Add2, v_num. |
| 75 | + + eauto using S_Add1. |
| 76 | + - (* tif c t e *) |
| 77 | + right; destruct IHHT1 as [Hvc | [c' Hc]]. |
| 78 | + + destruct (canon_bool c Hvc HT1) as [[] ->]; eauto using S_IfTrue, S_IfFalse. |
| 79 | + + eauto using S_If. |
| 80 | +Qed. |
| 81 | + |
| 82 | +(* ── preservation ──────────────────────────────────────────────────────── *) |
| 83 | + |
| 84 | +Theorem preservation : forall t t' T, has_type t T -> step t t' -> has_type t' T. |
| 85 | +Proof. |
| 86 | + intros t t' T HT Hstep; revert T HT. |
| 87 | + induction Hstep; intros T HT; inversion HT; subst. |
| 88 | + - apply T_Add; auto. |
| 89 | + - apply T_Add; auto. |
| 90 | + - constructor. |
| 91 | + - apply T_If; auto. |
| 92 | + - assumption. |
| 93 | + - assumption. |
| 94 | +Qed. |
| 95 | + |
| 96 | +(* ── discharge the stated obligations (ctx instantiated to unit) ────────── *) |
| 97 | + |
| 98 | +Definition P2_progress_discharged |
| 99 | + : P2_progress tm ty unit tt (fun (_ : unit) (t : tm) (T : ty) => has_type t T) |
| 100 | + value step |
| 101 | + := progress. |
| 102 | + |
| 103 | +Definition P2_preservation_discharged |
| 104 | + : P2_preservation tm ty unit (fun (_ : unit) (t : tm) (T : ty) => has_type t T) |
| 105 | + step |
| 106 | + := fun (_ : unit) t t' T HT Hs => preservation t t' T HT Hs. |
| 107 | + |
| 108 | +Print Assumptions P2_progress_discharged. |
| 109 | +Print Assumptions P2_preservation_discharged. |
0 commit comments