Skip to content

Commit 02a5851

Browse files
claudehyperpolymath
authored andcommitted
chore: preserve in-progress KRL Agda proofs (Properties -> GeneratorIndex + PortArity)
Preserves uncommitted work-in-progress found in the working tree from a prior session: a refactor splitting verification/proofs/agda/Properties.agda into two focused `agda --safe` proof modules: - GeneratorIndex.agda (KRL generator-index validity) - PortArity.agda (KRL port-arity proof) Also gitignores compiled *.agdai build artifacts. NOT authored or verified in this session — preserved as-is so it isn't lost in the ephemeral container. It has NOT been checked to compile; a reviewer should confirm `agda --safe` passes and that nothing still imports the removed Properties.agda before merging. https://claude.ai/code/session_017TXizM5c1Yd9HWf7Y15YH2
1 parent e42eeaf commit 02a5851

4 files changed

Lines changed: 290 additions & 37 deletions

File tree

.gitignore

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -112,3 +112,4 @@ deps/
112112
.cache/
113113
build/
114114
dist/
115+
*.agdai
Lines changed: 59 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,59 @@
1+
{-# OPTIONS --safe #-}
2+
-- SPDX-License-Identifier: MPL-2.0
3+
-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) <j.d.a.jewell@open.ac.uk>
4+
--
5+
-- ===========================================================================
6+
-- KRL generator-index validity — machine-checked under `agda --safe`
7+
-- ===========================================================================
8+
--
9+
-- Discharges obligation KR-7 from PROOF-NEEDS.md (was "PARTIAL: error path
10+
-- exists, not property-tested"):
11+
--
12+
-- KR-7 `sigma N`, `sigma_inv N`, `cup N`, `cap N` are accepted iff N ≥ 1.
13+
--
14+
-- KRL generators are written with a 1-based strand index (spec/grammar.ebnf:
15+
-- `crossing_gen = "sigma" , integer`, etc.). Index 0 names no strand pair
16+
-- and must be rejected at parse time. This module gives the reference
17+
-- semantics of that check and proves it correct in both directions; the
18+
-- Julia parser is property-tested against the same invariant.
19+
20+
module GeneratorIndex where
21+
22+
open import Data.Nat using (ℕ; zero; suc; _≤_; s≤s; z≤n)
23+
open import Data.Maybe using (Maybe; just; nothing)
24+
open import Data.Product using (∃; _,_)
25+
open import Relation.Binary.PropositionalEquality using (_≡_; refl)
26+
27+
-- A *validated* 1-based generator index: a number together with a proof it
28+
-- is at least 1. This is the shape the parser must guarantee downstream.
29+
record Index : Set where
30+
constructor idx
31+
field
32+
value :
33+
valid : 1 ≤ value
34+
35+
-- The parser's index check: accept iff the raw integer is ≥ 1.
36+
checkIndex : Maybe Index
37+
checkIndex zero = nothing
38+
checkIndex (suc n) = just (idx (suc n) (s≤s z≤n))
39+
40+
-- ── KR-7, the two directions ───────────────────────────────────────────────
41+
42+
-- completeness: every N ≥ 1 is accepted.
43+
accepts-iff-pos : {n} 1 ≤ n λ i checkIndex n ≡ just i
44+
accepts-iff-pos {suc n} _ = idx (suc n) (s≤s z≤n) , refl
45+
46+
-- soundness: anything accepted was ≥ 1.
47+
accepted-is-pos : {n i} checkIndex n ≡ just i 1 ≤ n
48+
accepted-is-pos {suc n} _ = s≤s z≤n
49+
accepted-is-pos {zero} ()
50+
51+
-- ── Concrete computational evidence ────────────────────────────────────────
52+
53+
-- `sigma 0` (index 0) is rejected.
54+
rejects-zero : checkIndex 0 ≡ nothing
55+
rejects-zero = refl
56+
57+
-- `sigma 1` (index 1) is accepted.
58+
accepts-one : checkIndex 1 ≡ just (idx 1 (s≤s z≤n))
59+
accepts-one = refl
Lines changed: 230 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,230 @@
1+
{-# OPTIONS --safe #-}
2+
-- SPDX-License-Identifier: MPL-2.0
3+
-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) <j.d.a.jewell@open.ac.uk>
4+
--
5+
-- ===========================================================================
6+
-- KRL port-arity proof — machine-checked under `agda --safe` (no unproven axioms)
7+
-- ===========================================================================
8+
--
9+
-- Discharges two obligations from PROOF-NEEDS.md / PROOF-NARRATIVE.md:
10+
--
11+
-- KR-1 `lower` is total on parseable programs
12+
-- (a parseable program never gets "stuck" in lowering; the only
13+
-- failure is a genuine arity mismatch reported cleanly as `nothing`).
14+
--
15+
-- KR-2 `lower` preserves port arity
16+
-- (every sub-expression `(compose a b)` is lowered only when
17+
-- out-ports(a) = in-ports(b), and the lowered TangleIR object has
18+
-- exactly the surface arity).
19+
--
20+
-- Modelled fragment — the CONSTRUCT + TRANSFORM + RESOLVE(close) fragment of
21+
-- KRL v0.1.0 (spec/grammar.ebnf): generators sigma / sigma_inv / cup / cap,
22+
-- sequential composition `;`, tensor `|`, the arity-preserving transforms
23+
-- mirror / simplify / normalise, and `close` (trace / closure).
24+
--
25+
-- Arity model — a *precise* refinement of ASSUMPTIONS A-KR-2.1 / A-KR-2.2.
26+
-- The narrative prose for `sigma` ("in=i, out=i+1 (and same arity in/out)")
27+
-- is internally contradictory and cannot be encoded as written; we take the
28+
-- standard PROP / oriented-Temperley-Lieb model, which honours the
29+
-- *consistent* part of the assumption (cup/cap exact; sigma arity-preserving):
30+
--
31+
-- sigma i, sigma_inv i : 2 → 2 (a crossing; in = out, per A-KR-2.1)
32+
-- cup i : 0 → 2 (exactly A-KR-2.1)
33+
-- cap i : 2 → 0 (exactly A-KR-2.1)
34+
-- a ; b (compose) : m → n requires out(a) = in(b)
35+
-- a | b (tensor) : (mₐ+m_b) → (nₐ+n_b) (exactly A-KR-2.2)
36+
-- mirror/simplify/normalise : arity-preserving
37+
-- close : n → n ↦ 0 → 0 (trace; requires square)
38+
--
39+
-- Validated against the canonical example from spec/grammar-overview.md,
40+
-- close (sigma 1 ; sigma 1 ; sigma 1) -- the trefoil
41+
-- which is well-formed with closed arity 0 → 0 (see `trefoil-lowers` below).
42+
-- The strand index `i` is retained as data; KRL v0.1.0 has no strand-count
43+
-- parameterisation (grammar-overview "Known gaps" #3), so locally it does not
44+
-- constrain arity. A future strand-indexed refinement is left open.
45+
--
46+
-- The RETRIEVE family (`find … where …` queries) and `classify` produce
47+
-- non-tangle results and are out of scope for the port-arity theorem.
48+
49+
module PortArity where
50+
51+
open import Data.Nat using (ℕ; zero; suc; _+_)
52+
open import Data.Nat.Properties using (_≟_; ≟-diag)
53+
open import Data.Maybe using (Maybe; just; nothing)
54+
open import Data.Product using (Σ; Σ-syntax; _×_; _,_; proj₁; proj₂)
55+
open import Data.Empty using (⊥-elim)
56+
open import Relation.Nullary using (yes; no)
57+
open import Relation.Binary.PropositionalEquality
58+
using (_≡_; _≢_; refl; cong)
59+
60+
-- ───────────────────────────────────────────────────────────────────────────
61+
-- Surface syntax: a *parseable* KRL tangle expression (untyped).
62+
-- ───────────────────────────────────────────────────────────────────────────
63+
64+
data Expr : Set where
65+
sigma sigmaInv cup cap : Expr
66+
_⨾_ _⊗_ : Expr Expr Expr -- compose ; , tensor |
67+
mirror simplify normalise close : Expr Expr
68+
69+
infixl 5 _⨾_
70+
infixl 6 _⊗_
71+
72+
-- ───────────────────────────────────────────────────────────────────────────
73+
-- TangleIR: intrinsically port-typed. `Tangle m n` is a tangle with m input
74+
-- ports and n output ports. The `Kseq` constructor makes an arity-mismatched
75+
-- composition *unrepresentable* — this is KR-2 baked into the type of the IR.
76+
-- ───────────────────────────────────────────────────────────────────────────
77+
78+
data Tangle : Set where
79+
: Tangle 2 2
80+
Kσ⁻ : Tangle 2 2
81+
K∪ : Tangle 0 2
82+
K∩ : Tangle 2 0
83+
Kseq : {m k n} Tangle m k Tangle k n Tangle m n
84+
Kpar : {m n p q} Tangle m n Tangle p q Tangle (m + p) (n + q)
85+
Kmir : {m n} Tangle m n Tangle m n
86+
Ksim : {m n} Tangle m n Tangle m n
87+
Knrm : {m n} Tangle m n Tangle m n
88+
Kcls : {n} Tangle n n Tangle 0 0
89+
90+
-- A lowered object packaged with its (input,output) arity.
91+
TypedTangle : Set
92+
TypedTangle = Σ[ mn ∈ ℕ × ℕ ] Tangle (proj₁ mn) (proj₂ mn)
93+
94+
arity : {m n} Tangle m n ℕ × ℕ
95+
arity {m} {n} _ = m , n
96+
97+
-- ───────────────────────────────────────────────────────────────────────────
98+
-- The lowering, in combinator style so the per-constructor equations hold
99+
-- definitionally (which keeps the proofs below clean).
100+
-- ───────────────────────────────────────────────────────────────────────────
101+
102+
-- sequential composition: succeeds iff the middle arities agree
103+
seqC : TypedTangle TypedTangle Maybe TypedTangle
104+
seqC ((ma , ka) , ta) ((kb , nb) , tb) with ka ≟ kb
105+
... | yes refl = just ((ma , nb) , Kseq ta tb)
106+
... | no _ = nothing
107+
108+
-- tensor: always succeeds, arities add
109+
parC : TypedTangle TypedTangle Maybe TypedTangle
110+
parC ((ma , na) , ta) ((mb , nb) , tb) =
111+
just ((ma + mb , na + nb) , Kpar ta tb)
112+
113+
-- arity-preserving unary transform
114+
mapC : ( {m n} Tangle m n Tangle m n) TypedTangle TypedTangle
115+
mapC f (mn , t) = mn , f t
116+
117+
-- closure / trace: succeeds iff the diagram is square (in = out)
118+
clsC : TypedTangle Maybe TypedTangle
119+
clsC ((m , n) , t) with m ≟ n
120+
... | yes refl = just ((0 , 0) , Kcls t)
121+
... | no _ = nothing
122+
123+
-- binary / unary Maybe plumbing (propagates `nothing`)
124+
bind₂ : Maybe TypedTangle Maybe TypedTangle
125+
(TypedTangle TypedTangle Maybe TypedTangle) Maybe TypedTangle
126+
bind₂ (just x) (just y) f = f x y
127+
bind₂ _ _ _ = nothing
128+
129+
mapMaybe : (TypedTangle TypedTangle) Maybe TypedTangle Maybe TypedTangle
130+
mapMaybe f (just x) = just (f x)
131+
mapMaybe _ nothing = nothing
132+
133+
bind₁ : Maybe TypedTangle (TypedTangle Maybe TypedTangle) Maybe TypedTangle
134+
bind₁ (just x) f = f x
135+
bind₁ nothing _ = nothing
136+
137+
-- The lowering function. Total: structural recursion accepted by Agda's
138+
-- own totality checker under `--safe` (no escape hatches): this *is* the
139+
-- witness for KR-1.
140+
compile : Expr Maybe TypedTangle
141+
compile (sigma i) = just ((2 , 2) , Kσ i)
142+
compile (sigmaInv i) = just ((2 , 2) , Kσ⁻ i)
143+
compile (cup i) = just ((0 , 2) , K∪ i)
144+
compile (cap i) = just ((2 , 0) , K∩ i)
145+
compile (a ⨾ b) = bind₂ (compile a) (compile b) seqC
146+
compile (a ⊗ b) = bind₂ (compile a) (compile b) parC
147+
compile (mirror e) = mapMaybe (mapC Kmir) (compile e)
148+
compile (simplify e) = mapMaybe (mapC Ksim) (compile e)
149+
compile (normalise e) = mapMaybe (mapC Knrm) (compile e)
150+
compile (close e) = bind₁ (compile e) clsC
151+
152+
-- alias under the obligation's name
153+
lower : Expr Maybe TypedTangle
154+
lower = compile
155+
156+
-- ===========================================================================
157+
-- KR-2 — port-arity preservation
158+
-- ===========================================================================
159+
160+
-- (definitional) the lowered IR has exactly the arity `compile` reports.
161+
lower-preserves-arity :
162+
e {mn} {t : Tangle (proj₁ mn) (proj₂ mn)}
163+
compile e ≡ just (mn , t) arity t ≡ mn
164+
lower-preserves-arity _ _ = refl
165+
166+
-- helper: `seqC` only fires when the middle arities are equal …
167+
seqC-nomatch :
168+
{ma ka kb nb} (ta : Tangle ma ka) (tb : Tangle kb nb)
169+
ka ≢ kb seqC ((ma , ka) , ta) ((kb , nb) , tb) ≡ nothing
170+
seqC-nomatch {_} {ka} {kb} ta tb ne with ka ≟ kb
171+
... | yes p = ⊥-elim (ne p)
172+
... | no _ = refl
173+
174+
-- (general) a composition is lowered only when out-ports(a) = in-ports(b);
175+
-- a genuine mismatch is rejected cleanly as `nothing`.
176+
compose-mismatch-rejected :
177+
{a b ma ka kb nb} {ta : Tangle ma ka} {tb : Tangle kb nb}
178+
compile a ≡ just ((ma , ka) , ta)
179+
compile b ≡ just ((kb , nb) , tb)
180+
ka ≢ kb
181+
compile (a ⨾ b) ≡ nothing
182+
compose-mismatch-rejected pa pb ne
183+
rewrite pa | pb = seqC-nomatch _ _ ne
184+
185+
-- helper: `seqC` fires when the middle arities agree.
186+
seqC-match :
187+
{ma k n} (ta : Tangle ma k) (tb : Tangle k n)
188+
seqC ((ma , k) , ta) ((k , n) , tb) ≡ just ((ma , n) , Kseq ta tb)
189+
seqC-match {_} {k} ta tb rewrite ≟-diag {k} {k} refl = refl
190+
191+
-- ===========================================================================
192+
-- KR-1 — lowering is total on parseable programs (no "stuck" states)
193+
-- ===========================================================================
194+
195+
-- (general, positive) matching arities ⇒ the composition lowers, and the
196+
-- lowered IR is exactly the sequential composition of the parts.
197+
compose-succeeds-on-match :
198+
{a b ma k n} (ta : Tangle ma k) (tb : Tangle k n)
199+
compile a ≡ just ((ma , k) , ta)
200+
compile b ≡ just ((k , n) , tb)
201+
compile (a ⨾ b) ≡ just ((ma , n) , Kseq ta tb)
202+
compose-succeeds-on-match ta tb pa pb
203+
rewrite pa | pb = seqC-match ta tb
204+
205+
-- ===========================================================================
206+
-- Concrete computational evidence (each is `refl` — `compile` actually runs)
207+
-- ===========================================================================
208+
209+
-- the canonical trefoil close (sigma 1 ; sigma 1 ; sigma 1) lowers,
210+
-- with closed arity 0 → 0.
211+
trefoil : Expr
212+
trefoil = close ((sigma 1 ⨾ sigma 1) ⨾ sigma 1)
213+
214+
trefoil-lowers :
215+
compile trefoil
216+
≡ just ((0 , 0) , Kcls (Kseq (Kseq (Kσ 1) (Kσ 1)) (Kσ 1)))
217+
trefoil-lowers = refl
218+
219+
-- tensor of two cups: (0→2) | (0→2) = 0 → 4
220+
two-cups : compile (cup 1 ⊗ cup 2) ≡ just ((0 , 4) , Kpar (K∪ 1) (K∪ 2))
221+
two-cups = refl
222+
223+
-- a genuine arity mismatch — sigma (2→2) then cup (0→2), 2 ≠ 0 — is rejected
224+
-- as `nothing` (a clean error), never "stuck".
225+
mismatch-rejected : compile (sigma 1 ⨾ cup 1) ≡ nothing
226+
mismatch-rejected = refl
227+
228+
-- a non-square diagram cannot be closed: cup (0→2) has 0 ≠ 2, so `close` fails.
229+
close-needs-square : compile (close (cup 1)) ≡ nothing
230+
close-needs-square = refl

verification/proofs/agda/Properties.agda

Lines changed: 0 additions & 37 deletions
This file was deleted.

0 commit comments

Comments
 (0)