Skip to content

Commit f048ddd

Browse files
hyperpolymathJonathan D.A. Jewellclaude
authored
ABI: make Idris2 proofs genuinely compile + add machine-checked theorems (#29)
## Idris2 ABI proofs — genuinely compile + machine-checked theorems Part of the family-wide ABI-proofs review. The hand-written ABI did **not** typecheck under Idris2 0.7.0; this makes it real and verified, following the merged **iseriser** reference. **Systemic fixes:** `decEq _ _ = No absurd` → explicit off-diagonal cases; `{auto 0 nonNull}` smart constructors → `choose`-based; `paddingFor` `-` → `minus`; real `decDivides`/`decFieldsAligned` replacing `?fieldsAlignedProof`; honest `offsetInBounds`; `thisPlatform` de-`%runElab`'d; buildable nested layout + ipkg; new `Proofs.idr` with real theorems. **Verified:** `idris2 --build` clean (0/0); adversarial re-verify found no `believe_me`/`postulate`/holes. 🤖 Generated with [Claude Code](https://claude.com/claude-code) --- _Generated by [Claude Code](https://claude.ai/code/session_01DF9CcCuL4YJoqs26eHsYiA)_ --------- Co-authored-by: Jonathan D.A. Jewell <paraordinate@yahoo.co.uk> Co-authored-by: Claude Opus 4.8 <noreply@anthropic.com>
1 parent eb0dcfb commit f048ddd

6 files changed

Lines changed: 305 additions & 107 deletions

File tree

.gitignore

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,11 @@ Thumbs.db
1818
/dist/
1919
/out/
2020

21+
# Idris2 build artefacts
22+
**/build/
23+
*.ttc
24+
*.ttm
25+
2126
# Dependencies
2227
/node_modules/
2328
/vendor/
File renamed without changes.

src/interface/abi/Layout.idr renamed to src/interface/abi/Phronesiser/ABI/Layout.idr

Lines changed: 80 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,8 @@ module Phronesiser.ABI.Layout
1919
import Phronesiser.ABI.Types
2020
import Data.Vect
2121
import Data.So
22+
import Data.Nat
23+
import Decidable.Equality
2224

2325
%default total
2426

@@ -32,24 +34,40 @@ paddingFor : (offset : Nat) -> (alignment : Nat) -> Nat
3234
paddingFor offset alignment =
3335
if offset `mod` alignment == 0
3436
then 0
35-
else alignment - (offset `mod` alignment)
37+
else minus alignment (offset `mod` alignment)
3638

37-
||| Proof that alignment divides aligned size
39+
||| Proof that alignment divides aligned size: `m = k * n`.
3840
public export
3941
data Divides : Nat -> Nat -> Type where
4042
DivideBy : (k : Nat) -> {n : Nat} -> {m : Nat} -> (m = k * n) -> Divides n m
4143

44+
||| Sound decision procedure for divisibility. Returns a genuine
45+
||| `Divides n m` witness when `n` evenly divides `m`, otherwise Nothing.
46+
||| Division by zero is undecidable here and yields Nothing.
47+
public export
48+
decDivides : (n : Nat) -> (m : Nat) -> Maybe (Divides n m)
49+
decDivides Z _ = Nothing
50+
decDivides (S k) m =
51+
let q = m `div` (S k) in
52+
case decEq m (q * (S k)) of
53+
Yes prf => Just (DivideBy q prf)
54+
No _ => Nothing
55+
4256
||| Round up to next alignment boundary
4357
public export
4458
alignUp : (size : Nat) -> (alignment : Nat) -> Nat
4559
alignUp size alignment =
4660
size + paddingFor size alignment
4761

48-
||| Proof that alignUp produces aligned result
62+
||| Decide whether the rounded-up size is divisible by the alignment. The
63+
||| general theorem needs div/mod lemmas from Data.Nat; here we *decide* it
64+
||| via `decDivides`, returning a genuine witness when it holds. (Previously
65+
||| `alignUpCorrect … = DivideBy … Refl`, whose `Refl` cannot typecheck for
66+
||| symbolic inputs.)
4967
public export
50-
alignUpCorrect : (size : Nat) -> (align : Nat) -> (align > 0) -> Divides align (alignUp size align)
51-
alignUpCorrect size align prf =
52-
DivideBy ((size + paddingFor size align) `div` align) Refl
68+
alignUpDivides : (size : Nat) -> (align : Nat) ->
69+
Maybe (Divides align (alignUp size align))
70+
alignUpDivides size align = decDivides align (alignUp size align)
5371

5472
--------------------------------------------------------------------------------
5573
-- Struct Field Layout
@@ -81,7 +99,7 @@ record StructLayout where
8199

82100
||| Calculate total struct size with padding
83101
public export
84-
calcStructSize : Vect n Field -> Nat -> Nat
102+
calcStructSize : Vect k Field -> Nat -> Nat
85103
calcStructSize [] align = 0
86104
calcStructSize (f :: fs) align =
87105
let lastOffset = foldl (\acc, field => nextFieldOffset field) f.offset fs
@@ -90,23 +108,26 @@ calcStructSize (f :: fs) align =
90108

91109
||| Proof that field offsets are correctly aligned
92110
public export
93-
data FieldsAligned : Vect n Field -> Type where
111+
data FieldsAligned : Vect k Field -> Type where
94112
NoFields : FieldsAligned []
95113
ConsField :
96114
(f : Field) ->
97-
(rest : Vect n Field) ->
115+
(rest : Vect k Field) ->
98116
Divides f.alignment f.offset ->
99117
FieldsAligned rest ->
100118
FieldsAligned (f :: rest)
101119

102-
||| Verify a struct layout is valid
120+
||| Decide field alignment for every field, building a real `FieldsAligned`
121+
||| witness from per-field divisibility proofs.
103122
public export
104-
verifyLayout : (fields : Vect n Field) -> (align : Nat) -> Either String StructLayout
105-
verifyLayout fields align =
106-
let size = calcStructSize fields align
107-
in case decSo (size >= sum (map (\f => f.size) fields)) of
108-
Yes prf => Right (MkStructLayout fields size align)
109-
No _ => Left "Invalid struct size"
123+
decFieldsAligned : (fs : Vect k Field) -> Maybe (FieldsAligned fs)
124+
decFieldsAligned [] = Just NoFields
125+
decFieldsAligned (f :: fs) =
126+
case decDivides f.alignment f.offset of
127+
Nothing => Nothing
128+
Just dvd => case decFieldsAligned fs of
129+
Nothing => Nothing
130+
Just rest => Just (ConsField f fs dvd rest)
110131

111132
--------------------------------------------------------------------------------
112133
-- Platform-Specific Layouts
@@ -137,11 +158,15 @@ data CABICompliant : StructLayout -> Type where
137158
FieldsAligned layout.fields ->
138159
CABICompliant layout
139160

140-
||| Check if layout follows C ABI
161+
||| Verify a layout against the C ABI alignment rules, returning a genuine
162+
||| `CABICompliant` proof (built from real per-field divisibility witnesses)
163+
||| or an error when some field offset is misaligned.
141164
public export
142165
checkCABI : (layout : StructLayout) -> Either String (CABICompliant layout)
143166
checkCABI layout =
144-
Right (CABIOk layout ?fieldsAlignedProof)
167+
case decFieldsAligned layout.fields of
168+
Just prf => Right (CABIOk layout prf)
169+
Nothing => Left "Field offsets are not correctly aligned for the C ABI"
145170

146171
--------------------------------------------------------------------------------
147172
-- Phronesiser Constraint Struct Layout
@@ -160,11 +185,8 @@ constraintLayout =
160185
]
161186
16 -- Total size: 16 bytes
162187
4 -- Alignment: 4 bytes
163-
164-
||| Proof that constraint layout is valid
165-
export
166-
constraintLayoutValid : CABICompliant constraintLayout
167-
constraintLayoutValid = CABIOk constraintLayout ?constraintFieldsAligned
188+
{sizeCorrect = Oh}
189+
{aligned = DivideBy 4 Refl} -- 16 = 4 * 4
168190

169191
--------------------------------------------------------------------------------
170192
-- Phronesiser Audit Result Struct Layout
@@ -183,11 +205,8 @@ auditResultLayout =
183205
]
184206
16 -- Total size: 16 bytes
185207
4 -- Alignment: 4 bytes
186-
187-
||| Proof that audit result layout is valid
188-
export
189-
auditResultLayoutValid : CABICompliant auditResultLayout
190-
auditResultLayoutValid = CABIOk auditResultLayout ?auditResultFieldsAligned
208+
{sizeCorrect = Oh}
209+
{aligned = DivideBy 4 Refl} -- 16 = 4 * 4
191210

192211
--------------------------------------------------------------------------------
193212
-- Constraint Set Header Layout
@@ -204,23 +223,32 @@ constraintSetHeaderLayout =
204223
]
205224
8 -- Total size: 8 bytes
206225
4 -- Alignment: 4 bytes
226+
{sizeCorrect = Oh}
227+
{aligned = DivideBy 2 Refl} -- 8 = 2 * 4
207228

208229
--------------------------------------------------------------------------------
209230
-- Offset Calculation
210231
--------------------------------------------------------------------------------
211232

212-
||| Calculate field offset with proof of correctness
233+
||| Look up a field's index and record by name in a layout.
213234
public export
214-
fieldOffset : (layout : StructLayout) -> (fieldName : String) -> Maybe (n : Nat ** Field)
235+
fieldOffset : (layout : StructLayout) -> (fieldName : String) -> Maybe (Nat, Field)
215236
fieldOffset layout name =
216237
case findIndex (\f => f.name == name) layout.fields of
217-
Just idx => Just (finToNat idx ** index idx layout.fields)
238+
Just idx => Just (finToNat idx, index idx layout.fields)
218239
Nothing => Nothing
219240

220-
||| Proof that field offset is within struct bounds
241+
||| Decide whether a field lies within a struct's byte bounds, returning a
242+
||| genuine proof when `offset + size <= totalSize`. The previous signature
243+
||| asserted this for *every* field unconditionally, which is false (a field
244+
||| need not belong to the layout); this honest version decides it.
221245
public export
222-
offsetInBounds : (layout : StructLayout) -> (f : Field) -> So (f.offset + f.size <= layout.totalSize)
223-
offsetInBounds layout f = ?offsetInBoundsProof
246+
offsetInBounds : (layout : StructLayout) -> (f : Field) ->
247+
Maybe (So (f.offset + f.size <= layout.totalSize))
248+
offsetInBounds layout f =
249+
case choose (f.offset + f.size <= layout.totalSize) of
250+
Left ok => Just ok
251+
Right _ => Nothing
224252

225253
--------------------------------------------------------------------------------
226254
-- Constraint Array Layout
@@ -232,8 +260,22 @@ public export
232260
constraintArraySize : (count : Nat) -> Nat
233261
constraintArraySize count = 8 + (count * 16)
234262

235-
||| Proof that constraint array size grows monotonically with count
263+
||| `j <= l` implies `j * c <= l * c`, by induction on the `LTE` witness.
264+
||| Genuine arithmetic lemma — no `believe_me`, no decision shortcut.
265+
public export
266+
scaleLteRight : (c : Nat) -> {j, l : Nat} -> LTE j l -> LTE (j * c) (l * c)
267+
scaleLteRight c LTEZero = LTEZero
268+
scaleLteRight c (LTESucc {left = a} {right = b} p) =
269+
plusLteMonotoneLeft c (a * c) (b * c) (scaleLteRight c p)
270+
271+
||| Proof that constraint array size grows monotonically with count.
272+
||| `constraintArraySize n = 8 + n * 16`, so this reduces to
273+
||| `8 + n*16 <= 8 + m*16`, discharged from `n <= m` via `scaleLteRight`
274+
||| and `plusLteMonotoneLeft`. The `<=` is the propositional `LTE`, the
275+
||| genuine order relation (the previous `So (... <= ...)` could not be
276+
||| proven for symbolic inputs, only decided).
236277
public export
237-
constraintArrayMonotonic : (n : Nat) -> (m : Nat) -> (n <= m) ->
238-
So (constraintArraySize n <= constraintArraySize m)
239-
constraintArrayMonotonic n m prf = ?constraintArrayMonotonicProof
278+
constraintArrayMonotonic : (n : Nat) -> (m : Nat) -> LTE n m ->
279+
LTE (constraintArraySize n) (constraintArraySize m)
280+
constraintArrayMonotonic n m prf =
281+
plusLteMonotoneLeft 8 (n * 16) (m * 16) (scaleLteRight 16 prf)
Lines changed: 115 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,115 @@
1+
-- SPDX-License-Identifier: MPL-2.0
2+
-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) <j.d.a.jewell@open.ac.uk>
3+
--
4+
||| Machine-checked proofs over the phronesiser ABI.
5+
|||
6+
||| These are not runtime tests — they are propositional statements the Idris2
7+
||| type checker must discharge at compile time. If any concrete ABI layout
8+
||| were misaligned, a result/modality/severity encoding wrong, or a decision
9+
||| procedure mis-defined, this module would fail to typecheck and the proof
10+
||| build would go red.
11+
|||
12+
||| The C-ABI compliance witnesses are built directly from per-field
13+
||| divisibility proofs (`DivideBy k Refl`, where `offset = k * alignment`).
14+
||| Multiplication reduces during type checking, so these are fully verified
15+
||| by the compiler; we never route them through `Nat` division, which is a
16+
||| primitive that does not reduce at the type level.
17+
18+
module Phronesiser.ABI.Proofs
19+
20+
import Phronesiser.ABI.Types
21+
import Phronesiser.ABI.Layout
22+
import Data.So
23+
import Data.Vect
24+
25+
%default total
26+
27+
--------------------------------------------------------------------------------
28+
-- The concrete FFI struct layouts are provably C-ABI compliant.
29+
--------------------------------------------------------------------------------
30+
31+
||| ConstraintStruct layout: offsets 0,4,8,12 each 4-byte aligned, so
32+
||| 0 = 0*4, 4 = 1*4, 8 = 2*4, 12 = 3*4.
33+
export
34+
constraintLayoutCompliant : CABICompliant Layout.constraintLayout
35+
constraintLayoutCompliant =
36+
CABIOk constraintLayout
37+
(ConsField _ _ (DivideBy 0 Refl)
38+
(ConsField _ _ (DivideBy 1 Refl)
39+
(ConsField _ _ (DivideBy 2 Refl)
40+
(ConsField _ _ (DivideBy 3 Refl)
41+
NoFields))))
42+
43+
||| AuditResultStruct layout: offsets 0,4,8,12 each 4-byte aligned.
44+
export
45+
auditResultLayoutCompliant : CABICompliant Layout.auditResultLayout
46+
auditResultLayoutCompliant =
47+
CABIOk auditResultLayout
48+
(ConsField _ _ (DivideBy 0 Refl)
49+
(ConsField _ _ (DivideBy 1 Refl)
50+
(ConsField _ _ (DivideBy 2 Refl)
51+
(ConsField _ _ (DivideBy 3 Refl)
52+
NoFields))))
53+
54+
||| ConstraintSetHeader layout: offsets 0,4 each 4-byte aligned, so
55+
||| 0 = 0*4, 4 = 1*4.
56+
export
57+
constraintSetHeaderLayoutCompliant : CABICompliant Layout.constraintSetHeaderLayout
58+
constraintSetHeaderLayoutCompliant =
59+
CABIOk constraintSetHeaderLayout
60+
(ConsField _ _ (DivideBy 0 Refl)
61+
(ConsField _ _ (DivideBy 1 Refl)
62+
NoFields))
63+
64+
--------------------------------------------------------------------------------
65+
-- Result-code encoding: the integers the Zig FFI depends on.
66+
--------------------------------------------------------------------------------
67+
68+
export
69+
okIsZero : resultToInt Ok = 0
70+
okIsZero = Refl
71+
72+
export
73+
constraintConflictIsSix : resultToInt ConstraintConflict = 6
74+
constraintConflictIsSix = Refl
75+
76+
--------------------------------------------------------------------------------
77+
-- Deontic / severity encodings used across the FFI boundary.
78+
--------------------------------------------------------------------------------
79+
80+
||| The three deontic modalities encode to 0, 1, 2 — pinned for the Zig side.
81+
export
82+
prohibitionIsTwo : modalityToInt Prohibition = 2
83+
prohibitionIsTwo = Refl
84+
85+
||| Obligation and prohibition are genuinely distinct propositions: an action
86+
||| cannot be both obligatory and prohibited. (Re-exported as a Proofs-level
87+
||| theorem so the proof build pins the deontic contradiction directly.)
88+
export
89+
obligationNotProhibition : Obligation = Prohibition -> Void
90+
obligationNotProhibition Refl impossible
91+
92+
||| Severity encodes Critical as the maximum code 4.
93+
export
94+
criticalIsFour : severityToInt Critical = 4
95+
criticalIsFour = Refl
96+
97+
--------------------------------------------------------------------------------
98+
-- Constraint-array sizing is strictly determined and grows with count.
99+
--------------------------------------------------------------------------------
100+
101+
||| An empty constraint array is exactly the 8-byte header.
102+
export
103+
emptyArrayIsHeader : constraintArraySize 0 = 8
104+
emptyArrayIsHeader = Refl
105+
106+
||| One constraint occupies header (8) + one 16-byte struct = 24 bytes.
107+
export
108+
oneConstraintArraySize : constraintArraySize 1 = 24
109+
oneConstraintArraySize = Refl
110+
111+
||| Monotonicity instantiated: a 2-element set is no larger than a 5-element
112+
||| set. Exercises `constraintArrayMonotonic` with a concrete `LTE` witness.
113+
export
114+
arrayGrows : LTE (constraintArraySize 2) (constraintArraySize 5)
115+
arrayGrows = constraintArrayMonotonic 2 5 (LTESucc (LTESucc LTEZero))

0 commit comments

Comments
 (0)