@@ -14,6 +14,8 @@ module Oblibeniser.ABI.Layout
1414import Oblibeniser.ABI.Types
1515import Data.Vect
1616import Data.So
17+ import Data.Nat
18+ import Decidable.Equality
1719
1820%default total
1921
@@ -27,25 +29,42 @@ paddingFor : (offset : Nat) -> (alignment : Nat) -> Nat
2729paddingFor offset alignment =
2830 if offset `mod` alignment == 0
2931 then 0
30- else alignment - (offset `mod` alignment)
31-
32- ||| Proof that alignment divides aligned size
33- public export
34- data Divides : Nat -> Nat -> Type where
35- DivideBy : (k : Nat ) -> {n : Nat } -> {m : Nat } -> (m = k * n) -> Divides n m
32+ else minus alignment (offset `mod` alignment)
3633
3734||| Round up to next alignment boundary
3835public export
3936alignUp : (size : Nat ) -> (alignment : Nat ) -> Nat
4037alignUp size alignment =
4138 size + paddingFor size alignment
4239
43- ||| Proof that alignUp produces aligned result
40+ ||| Proof that alignment divides aligned size: `m = k * n`.
41+ public export
42+ data Divides : Nat -> Nat -> Type where
43+ DivideBy : (k : Nat ) -> {n : Nat } -> {m : Nat } -> (m = k * n) -> Divides n m
44+
45+ ||| Sound decision procedure for divisibility. Returns a genuine
46+ ||| `Divides n m` witness when `n` evenly divides `m`, otherwise Nothing.
47+ ||| Division by zero is undecidable here and yields Nothing.
48+ public export
49+ decDivides : (n : Nat ) -> (m : Nat ) -> Maybe (Divides n m)
50+ decDivides Z _ = Nothing
51+ decDivides (S k) m =
52+ let q = m `div` (S k) in
53+ case decEq m (q * (S k)) of
54+ Yes prf => Just (DivideBy q prf)
55+ No _ => Nothing
56+
57+ ||| Sound divisibility check for an aligned size. The general theorem
58+ ||| "alignUp size align is always divisible by align" needs div/mod lemmas
59+ ||| from Data.Nat and is tracked as residual proof work; here we *decide* it
60+ ||| via `decDivides`, which returns a genuine witness when it holds. For the
61+ ||| concrete ABI layouts below, divisibility is proven outright (`DivideBy`).
62+ ||| (Previously `alignUpCorrect … = DivideBy … Refl`, whose `Refl` cannot
63+ ||| typecheck for symbolic inputs.)
4464public export
45- alignUpCorrect : (size : Nat ) -> (align : Nat ) -> (align > 0) -> Divides align (alignUp size align)
46- alignUpCorrect size align prf =
47- -- Proof that (size + padding) is divisible by align
48- DivideBy ((size + paddingFor size align) `div` align) Refl
65+ alignUpDivides : (size : Nat ) -> (align : Nat ) ->
66+ Maybe (Divides align (alignUp size align))
67+ alignUpDivides size align = decDivides align (alignUp size align)
4968
5069-- ------------------------------------------------------------------------------
5170-- Struct Field Layout
@@ -77,7 +96,7 @@ record StructLayout where
7796
7897||| Calculate total struct size with padding
7998public export
80- calcStructSize : Vect n Field -> Nat -> Nat
99+ calcStructSize : Vect k Field -> Nat -> Nat
81100calcStructSize [] align = 0
82101calcStructSize (f :: fs) align =
83102 let lastOffset = foldl (\ acc, field => nextFieldOffset field) f. offset fs
@@ -86,23 +105,26 @@ calcStructSize (f :: fs) align =
86105
87106||| Proof that field offsets are correctly aligned
88107public export
89- data FieldsAligned : Vect n Field -> Type where
108+ data FieldsAligned : Vect k Field -> Type where
90109 NoFields : FieldsAligned []
91110 ConsField :
92111 (f : Field) ->
93- (rest : Vect n Field) ->
112+ (rest : Vect k Field) ->
94113 Divides f.alignment f.offset ->
95114 FieldsAligned rest ->
96115 FieldsAligned (f :: rest)
97116
98- ||| Verify a struct layout is valid
117+ ||| Decide field alignment for every field, building a real `FieldsAligned`
118+ ||| witness from per-field divisibility proofs.
99119public export
100- verifyLayout : (fields : Vect n Field) -> (align : Nat ) -> Either String StructLayout
101- verifyLayout fields align =
102- let size = calcStructSize fields align
103- in case decSo (size >= sum (map (\ f => f. size) fields)) of
104- Yes prf => Right (MkStructLayout fields size align)
105- No _ => Left " Invalid struct size"
120+ decFieldsAligned : (fs : Vect k Field) -> Maybe (FieldsAligned fs)
121+ decFieldsAligned [] = Just NoFields
122+ decFieldsAligned (f :: fs) =
123+ case decDivides f. alignment f. offset of
124+ Nothing => Nothing
125+ Just dvd => case decFieldsAligned fs of
126+ Nothing => Nothing
127+ Just rest => Just (ConsField f fs dvd rest)
106128
107129-- ------------------------------------------------------------------------------
108130-- Platform-Specific Layouts
@@ -113,14 +135,8 @@ public export
113135PlatformLayout : Platform -> Type -> Type
114136PlatformLayout p t = StructLayout
115137
116- ||| Verify layout is correct for all platforms
117- public export
118- verifyAllPlatforms :
119- (layouts : (p : Platform) -> PlatformLayout p t) ->
120- Either String ()
121- verifyAllPlatforms layouts =
122- -- Check that layout is valid on all platforms
123- Right ()
138+ -- `verifyAllLayouts` is defined at the end of this module, after the concrete
139+ -- layouts and `checkCABI` it depends on.
124140
125141-- ------------------------------------------------------------------------------
126142-- C ABI Compatibility
@@ -134,12 +150,15 @@ data CABICompliant : StructLayout -> Type where
134150 FieldsAligned layout.fields ->
135151 CABICompliant layout
136152
137- ||| Check if layout follows C ABI
153+ ||| Verify a layout against the C ABI alignment rules, returning a genuine
154+ ||| `CABICompliant` proof (built from real per-field divisibility witnesses)
155+ ||| or an error when some field offset is misaligned.
138156public export
139157checkCABI : (layout : StructLayout) -> Either String (CABICompliant layout)
140158checkCABI layout =
141- -- Verify C ABI rules
142- Right (CABIOk layout ? fieldsAlignedProof)
159+ case decFieldsAligned layout. fields of
160+ Just prf => Right (CABIOk layout prf)
161+ Nothing => Left " Field offsets are not correctly aligned for the C ABI"
143162
144163-- ------------------------------------------------------------------------------
145164-- AuditEntry Layout (oblibeniser-specific)
@@ -171,11 +190,24 @@ auditEntryLayout =
171190 ]
172191 64 -- Total size: 64 bytes (with 4 bytes trailing padding)
173192 8 -- Alignment: 8 bytes
193+ {sizeCorrect = Oh }
194+ {aligned = DivideBy 8 Refl }
174195
175- ||| Proof that AuditEntry layout is C-ABI compliant
196+ ||| Proof that AuditEntry layout is C-ABI compliant. Each field offset
197+ ||| divides its alignment: 0|8, 8|8, 16|8, 24|8, 32|8, 40|8, 48|8, 56|4.
176198export
177- auditEntryLayoutValid : CABICompliant auditEntryLayout
178- auditEntryLayoutValid = CABIOk auditEntryLayout ? auditEntryFieldsAligned
199+ auditEntryLayoutValid : CABICompliant Layout.auditEntryLayout
200+ auditEntryLayoutValid =
201+ CABIOk auditEntryLayout
202+ (ConsField _ _ (DivideBy 0 Refl )
203+ (ConsField _ _ (DivideBy 1 Refl )
204+ (ConsField _ _ (DivideBy 2 Refl )
205+ (ConsField _ _ (DivideBy 3 Refl )
206+ (ConsField _ _ (DivideBy 4 Refl )
207+ (ConsField _ _ (DivideBy 5 Refl )
208+ (ConsField _ _ (DivideBy 6 Refl )
209+ (ConsField _ _ (DivideBy 14 Refl )
210+ NoFields ))))))))
179211
180212-- ------------------------------------------------------------------------------
181213-- StateSnapshot Layout (oblibeniser-specific)
@@ -201,11 +233,21 @@ stateSnapshotLayout =
201233 ]
202234 40 -- Total size: 40 bytes (with 4 bytes internal padding after stateSize)
203235 8 -- Alignment: 8 bytes
236+ {sizeCorrect = Oh }
237+ {aligned = DivideBy 5 Refl }
204238
205- ||| Proof that StateSnapshot layout is C-ABI compliant
239+ ||| Proof that StateSnapshot layout is C-ABI compliant. Each field offset
240+ ||| divides its alignment: 0|8, 8|8, 16|8, 24|4, 32|8.
206241export
207- stateSnapshotLayoutValid : CABICompliant stateSnapshotLayout
208- stateSnapshotLayoutValid = CABIOk stateSnapshotLayout ? snapshotFieldsAligned
242+ stateSnapshotLayoutValid : CABICompliant Layout.stateSnapshotLayout
243+ stateSnapshotLayoutValid =
244+ CABIOk stateSnapshotLayout
245+ (ConsField _ _ (DivideBy 0 Refl )
246+ (ConsField _ _ (DivideBy 1 Refl )
247+ (ConsField _ _ (DivideBy 2 Refl )
248+ (ConsField _ _ (DivideBy 6 Refl )
249+ (ConsField _ _ (DivideBy 4 Refl )
250+ NoFields )))))
209251
210252-- ------------------------------------------------------------------------------
211253-- UndoStack Layout (oblibeniser-specific)
@@ -228,25 +270,53 @@ undoStackLayout =
228270 ]
229271 24 -- Total size: 24 bytes
230272 8 -- Alignment: 8 bytes
273+ {sizeCorrect = Oh }
274+ {aligned = DivideBy 3 Refl }
231275
232- ||| Proof that UndoStack layout is C-ABI compliant
276+ ||| Proof that UndoStack layout is C-ABI compliant. Each field offset
277+ ||| divides its alignment: 0|8, 8|4, 12|4, 16|8.
233278export
234- undoStackLayoutValid : CABICompliant undoStackLayout
235- undoStackLayoutValid = CABIOk undoStackLayout ? undoStackFieldsAligned
279+ undoStackLayoutValid : CABICompliant Layout.undoStackLayout
280+ undoStackLayoutValid =
281+ CABIOk undoStackLayout
282+ (ConsField _ _ (DivideBy 0 Refl )
283+ (ConsField _ _ (DivideBy 2 Refl )
284+ (ConsField _ _ (DivideBy 3 Refl )
285+ (ConsField _ _ (DivideBy 2 Refl )
286+ NoFields ))))
236287
237288-- ------------------------------------------------------------------------------
238289-- Offset Calculation
239290-- ------------------------------------------------------------------------------
240291
241- ||| Calculate field offset with proof of correctness
292+ ||| Look up a field's offset by name in a layout.
242293public export
243- fieldOffset : (layout : StructLayout) -> (fieldName : String) -> Maybe (n : Nat ** Field)
294+ fieldOffset : (layout : StructLayout) -> (fieldName : String) -> Maybe (Nat , Field)
244295fieldOffset layout name =
245296 case findIndex (\ f => f. name == name) layout. fields of
246- Just idx => Just (finToNat idx ** index idx layout. fields)
297+ Just idx => Just (finToNat idx, index idx layout. fields)
247298 Nothing => Nothing
248299
249- ||| Proof that field offset is within struct bounds
300+ ||| Decide whether a field lies within a struct's byte bounds, returning a
301+ ||| genuine proof when `offset + size <= totalSize`. The previous signature
302+ ||| asserted this for *every* field unconditionally, which is false (a field
303+ ||| need not belong to the layout); this honest version decides it.
304+ public export
305+ offsetInBounds : (layout : StructLayout) -> (f : Field) ->
306+ Maybe (So (f.offset + f.size <= layout.totalSize))
307+ offsetInBounds layout f =
308+ case choose (f. offset + f. size <= layout. totalSize) of
309+ Left ok => Just ok
310+ Right _ => Nothing
311+
312+ ||| Verify that all oblibeniser concrete layouts are C-ABI compliant. This
313+ ||| fails (Left) if any concrete layout is misaligned, rather than asserting
314+ ||| it. Each layout's `FieldsAligned` witness is built by `checkCABI`'s sound
315+ ||| `decFieldsAligned`.
250316public export
251- offsetInBounds : (layout : StructLayout) -> (f : Field) -> So (f.offset + f.size <= layout.totalSize)
252- offsetInBounds layout f = ? offsetInBoundsProof
317+ verifyAllLayouts : Either String ()
318+ verifyAllLayouts = do
319+ _ <- checkCABI auditEntryLayout
320+ _ <- checkCABI stateSnapshotLayout
321+ _ <- checkCABI undoStackLayout
322+ Right ()
0 commit comments