|
| 1 | +(* SPDX-License-Identifier: MPL-2.0 *) |
| 2 | +(* SPDX-FileCopyrightText: 2026 Jonathan D.A. Jewell (hyperpolymath) *) |
| 3 | + |
| 4 | +(* |
| 5 | + QttDynamic.v |
| 6 | + ════════════ |
| 7 | + Wave 3, the DYNAMIC half of P-4. QttTyping.v proved the *static* quantity |
| 8 | + discipline sound — the typing context records exactly the usage |
| 9 | + (`usage x t = Γ x`). This file proves that discipline is preserved **under |
| 10 | + reduction**: a small-step β-reduction relation on the QTT term language |
| 11 | + (`AffineUsage.tm`) carries the whole usage profile forward unchanged. |
| 12 | +
|
| 13 | + Headline — `step_preserves_usage`: |
| 14 | +
|
| 15 | + t → t' → ∀ z, usage z t' = usage z t |
| 16 | +
|
| 17 | + so the quantity accounting is a dynamic invariant. Composed with QttTyping's |
| 18 | + `usage_soundness` it yields the capstone-completing corollary |
| 19 | + `qtt_context_preserved`: |
| 20 | +
|
| 21 | + qtt Γ t A → t → t' → ∀ x, usage x t' = Γ x |
| 22 | +
|
| 23 | + — a well-typed term's QTT context stays valid across a reduction step. |
| 24 | +
|
| 25 | + Two further results expose the QTT *scaling* law that makes substructurality |
| 26 | + bite. Substituting v for a variable used at multiplicity q scales v's usage by |
| 27 | + q (`usage_subst_scaling`, via the new ×-homomorphism `qof_mult`); and an |
| 28 | + affine redex never increases any variable's usage (`affine_no_increase`) — the |
| 29 | + dynamic face of the affine bound. β here substitutes a *closed* value (the |
| 30 | + call-by-value, closed-program convention P2_Stlc.v also uses), so capture |
| 31 | + cannot arise and the development stays axiom-free — no Admitted, no axioms. |
| 32 | +
|
| 33 | + `.v` is Coq, not V-lang — see formal/README.adoc and .hypatia-ignore. |
| 34 | +*) |
| 35 | + |
| 36 | +Require Import PeanoNat. |
| 37 | +Require Import Lia. |
| 38 | +Require Import ASFormal.QttSemiring. |
| 39 | +Require Import ASFormal.AffineUsage. |
| 40 | +Require Import ASFormal.QttTyping. |
| 41 | + |
| 42 | +(* ── qof is also a homomorphism for multiplication ────────────────────────── |
| 43 | + QttSemiring gives qof_plus (occurrences add); the scaling law below needs the |
| 44 | + × analogue (occurrences multiply through a binder of a given multiplicity). *) |
| 45 | +Lemma qof_mult : forall m n, qof (m * n) = qmult (qof m) (qof n). |
| 46 | +Proof. |
| 47 | + intros m n; destruct m as [|[|m]]; destruct n as [|[|n]]; |
| 48 | + try reflexivity; rewrite Nat.mul_0_r; reflexivity. |
| 49 | +Qed. |
| 50 | + |
| 51 | +(* ── capture-permitting substitution (only ever applied to closed values) ─── *) |
| 52 | +Fixpoint subst (x : id) (s t : tm) : tm := |
| 53 | + match t with |
| 54 | + | var y => if Nat.eqb x y then s else var y |
| 55 | + | app f a => app (subst x s f) (subst x s a) |
| 56 | + | lam y b => if Nat.eqb x y then lam y b else lam y (subst x s b) |
| 57 | + end. |
| 58 | + |
| 59 | +Definition closed (t : tm) : Prop := forall z, count z t = 0. |
| 60 | + |
| 61 | +(* ── small-step β-reduction (call-by-value, closed argument) ──────────────── *) |
| 62 | +Inductive value : tm -> Prop := |
| 63 | +| v_lam : forall x b, value (lam x b). |
| 64 | + |
| 65 | +Inductive step : tm -> tm -> Prop := |
| 66 | +| ST_AppAbs : forall x b v, |
| 67 | + value v -> closed v -> step (app (lam x b) v) (subst x v b) |
| 68 | +| ST_App1 : forall f f' a, step f f' -> step (app f a) (app f' a) |
| 69 | +| ST_App2 : forall f a a', value f -> step a a' -> step (app f a) (app f a'). |
| 70 | + |
| 71 | +(* ── substituting a closed value: counts untouched off x, zeroed at x ─────── *) |
| 72 | + |
| 73 | +Lemma count_subst_closed_diff : forall x v b z, |
| 74 | + closed v -> z <> x -> count z (subst x v b) = count z b. |
| 75 | +Proof. |
| 76 | + intros x v b z Hc Hzx. |
| 77 | + induction b as [ y | f IHf a IHa | y b IHb ]. |
| 78 | + - (* var y *) cbn [subst]. destruct (Nat.eqb x y) eqn:E. |
| 79 | + + rewrite (Hc z). apply Nat.eqb_eq in E; subst y. |
| 80 | + cbn. apply Nat.eqb_neq in Hzx. rewrite Hzx. reflexivity. |
| 81 | + + reflexivity. |
| 82 | + - (* app *) simpl. rewrite IHf, IHa. reflexivity. |
| 83 | + - (* lam y b *) cbn [subst]. destruct (Nat.eqb x y) eqn:E. |
| 84 | + + reflexivity. |
| 85 | + + simpl. destruct (Nat.eqb z y); [ reflexivity | exact IHb ]. |
| 86 | +Qed. |
| 87 | + |
| 88 | +Lemma count_subst_closed_same : forall x v b, |
| 89 | + closed v -> count x (subst x v b) = 0. |
| 90 | +Proof. |
| 91 | + intros x v b Hc. |
| 92 | + induction b as [ y | f IHf a IHa | y b IHb ]. |
| 93 | + - cbn [subst]. destruct (Nat.eqb x y) eqn:E. |
| 94 | + + apply (Hc x). |
| 95 | + + cbn. rewrite E. reflexivity. |
| 96 | + - simpl. rewrite IHf, IHa. reflexivity. |
| 97 | + - cbn [subst]. destruct (Nat.eqb x y) eqn:E. |
| 98 | + + cbn. rewrite E. reflexivity. |
| 99 | + + cbn. rewrite E. exact IHb. |
| 100 | +Qed. |
| 101 | + |
| 102 | +(* ── headline: reduction preserves the full usage profile ─────────────────── *) |
| 103 | + |
| 104 | +Theorem step_preserves_usage : forall t t', |
| 105 | + step t t' -> forall z, usage z t' = usage z t. |
| 106 | +Proof. |
| 107 | + intros t t' Hs; induction Hs as |
| 108 | + [ x b v Hval Hcl | f f' a Hs IH | f a a' Hval Hs IH ]; intro z. |
| 109 | + - (* ST_AppAbs *) |
| 110 | + rewrite usage_app. |
| 111 | + assert (Hzv : usage z v = Zero) by (unfold usage; rewrite Hcl; reflexivity). |
| 112 | + rewrite Hzv, qplus_0_r. |
| 113 | + destruct (Nat.eqb z x) eqn:E. |
| 114 | + + apply Nat.eqb_eq in E; subst z. |
| 115 | + rewrite usage_lam_bound. |
| 116 | + unfold usage; rewrite (count_subst_closed_same x v b Hcl); reflexivity. |
| 117 | + + assert (Hzx : z <> x) by (apply Nat.eqb_neq; exact E). |
| 118 | + unfold usage. rewrite (count_subst_closed_diff x v b z Hcl Hzx). |
| 119 | + simpl. rewrite E. reflexivity. |
| 120 | + - (* ST_App1 *) rewrite !usage_app, (IH z). reflexivity. |
| 121 | + - (* ST_App2 *) rewrite !usage_app, (IH z). reflexivity. |
| 122 | +Qed. |
| 123 | + |
| 124 | +(* ── the QTT scaling law (binder-free fragment, open v) ──────────────────── |
| 125 | + Substituting v for x scales v's usage by x's multiplicity: |
| 126 | + usage z (subst x v b) = usage z b + (usage x b · usage z v). |
| 127 | + Stated on the lam-free fragment so capture cannot arise even for open v — |
| 128 | + enough to exhibit the qmult scaling that the closed-value headline hides. *) |
| 129 | + |
| 130 | +Fixpoint lam_free (t : tm) : Prop := |
| 131 | + match t with |
| 132 | + | var _ => True |
| 133 | + | app f a => lam_free f /\ lam_free a |
| 134 | + | lam _ _ => False |
| 135 | + end. |
| 136 | + |
| 137 | +Lemma usage_subst_scaling : forall x v b z, |
| 138 | + z <> x -> lam_free b -> |
| 139 | + usage z (subst x v b) = qplus (usage z b) (qmult (usage x b) (usage z v)). |
| 140 | +Proof. |
| 141 | + intros x v b; induction b as [ y | f IHf a IHa | y b IHb ]; |
| 142 | + intros z Hzx Hlf. |
| 143 | + - (* var y *) cbn [subst]. destruct (Nat.eqb x y) eqn:E. |
| 144 | + + apply Nat.eqb_eq in E; subst y. |
| 145 | + rewrite (usage_var_diff z x Hzx), (usage_var_same x), qmult_1_l, qplus_0_l. |
| 146 | + reflexivity. |
| 147 | + + assert (Hxy : x <> y) by (apply Nat.eqb_neq; exact E). |
| 148 | + rewrite (usage_var_diff x y Hxy), qmult_0_l, qplus_0_r. reflexivity. |
| 149 | + - (* app f a *) destruct Hlf as [Hlf Hla]. |
| 150 | + cbn [subst]. |
| 151 | + rewrite (usage_app z (subst x v f) (subst x v a)). |
| 152 | + rewrite (IHf z Hzx Hlf), (IHa z Hzx Hla). |
| 153 | + rewrite (usage_app z f a), (usage_app x f a). |
| 154 | + destruct (usage z f), (usage x f), (usage z a), (usage x a), (usage z v); |
| 155 | + reflexivity. |
| 156 | + - (* lam *) cbn in Hlf; destruct Hlf. |
| 157 | +Qed. |
| 158 | + |
| 159 | +(* An affine redex (bound variable used ≤ 1×) never increases any variable's |
| 160 | + usage: the dynamic counterpart of the static affine bound. *) |
| 161 | +Corollary affine_no_increase : forall x v b z, |
| 162 | + z <> x -> lam_free b -> qle (usage x b) One -> |
| 163 | + qle (usage z (subst x v b)) (qplus (usage z b) (usage z v)). |
| 164 | +Proof. |
| 165 | + intros x v b z Hzx Hlf Haff. |
| 166 | + rewrite usage_subst_scaling by assumption. |
| 167 | + revert Haff; unfold qle. |
| 168 | + destruct (usage x b), (usage z b), (usage z v); simpl; lia. |
| 169 | +Qed. |
| 170 | + |
| 171 | +(* A *linear* redex (bound variable used exactly once) preserves usage exactly, |
| 172 | + matching the closed-value headline but now for open v. *) |
| 173 | +Corollary linear_exact : forall x v b z, |
| 174 | + z <> x -> lam_free b -> usage x b = One -> |
| 175 | + usage z (subst x v b) = qplus (usage z b) (usage z v). |
| 176 | +Proof. |
| 177 | + intros x v b z Hzx Hlf Hlin. |
| 178 | + rewrite usage_subst_scaling by assumption. |
| 179 | + rewrite Hlin, qmult_1_l. reflexivity. |
| 180 | +Qed. |
| 181 | + |
| 182 | +(* ── tie back to the Wave-3 static capstone ───────────────────────────────── *) |
| 183 | + |
| 184 | +(* A well-typed term's QTT context stays valid across a reduction step: |
| 185 | + static usage_soundness (qtt Γ t A → usage x t = Γ x) composed with the |
| 186 | + dynamic invariant. Static + dynamic ⇒ the quantity discipline is sound. *) |
| 187 | +Corollary qtt_context_preserved : forall G t A t', |
| 188 | + qtt G t A -> step t t' -> forall x, usage x t' = G x. |
| 189 | +Proof. |
| 190 | + intros G t A t' HT Hs x. |
| 191 | + rewrite (step_preserves_usage t t' Hs x). |
| 192 | + exact (usage_soundness G t A HT x). |
| 193 | +Qed. |
| 194 | + |
| 195 | +Print Assumptions step_preserves_usage. |
| 196 | +Print Assumptions usage_subst_scaling. |
| 197 | +Print Assumptions qtt_context_preserved. |
0 commit comments