@@ -17,6 +17,8 @@ module Bqniser.ABI.Layout
1717import Bqniser.ABI.Types
1818import Data.Vect
1919import Data.So
20+ import Data.Nat
21+ import Decidable.Equality
2022
2123%default total
2224
@@ -55,11 +57,21 @@ arrayByteSize layout =
5557 dataSize = layout. elemCount * layout. elemSize
5658 in headerSize + shapeSize + dataSize
5759
58- ||| Proof that array byte size is always >= 8 (at minimum the header)
60+ ||| `8 + n` is at least 8 for every `n`. `(>=)` on Nat routes through
61+ ||| `compare`, which does not reduce for a symbolic tail, so we case on `n`:
62+ ||| both `compare Z Z = EQ` and `compare (S k) Z = GT` reduce, never `LT`.
63+ geEight : (n : Nat ) -> So ((8 + n) >= 8)
64+ geEight Z = Oh
65+ geEight (S _ ) = Oh
66+
67+ ||| Proof that array byte size is always >= 8 (at minimum the header).
68+ ||| `arrayByteSize = (8 + rank*8) + dataSize`; reassociate to `8 + (...)`
69+ ||| and discharge with `geEight`.
5970public export
6071arraySizeMinHeader : {rank : Nat } -> (layout : BQNArrayLayout rank) ->
6172 So (arrayByteSize layout >= 8)
62- arraySizeMinHeader layout = ? arraySizeMinHeaderProof
73+ arraySizeMinHeader (MkBQNArrayLayout _ _ _ elemSize elemCount) =
74+ geEight (rank * 8 + elemCount * elemSize)
6375
6476||| Calculate element count from shape (product of extents)
6577public export
@@ -82,24 +94,40 @@ paddingFor : (offset : Nat) -> (alignment : Nat) -> Nat
8294paddingFor offset alignment =
8395 if offset `mod` alignment == 0
8496 then 0
85- else alignment - (offset `mod` alignment)
97+ else minus alignment (offset `mod` alignment)
8698
87- ||| Proof that alignment divides aligned size
99+ ||| Proof that alignment divides aligned size: `m = k * n`.
88100public export
89101data Divides : Nat -> Nat -> Type where
90102 DivideBy : (k : Nat ) -> {n : Nat } -> {m : Nat } -> (m = k * n) -> Divides n m
91103
104+ ||| Sound decision procedure for divisibility. Returns a genuine
105+ ||| `Divides n m` witness when `n` evenly divides `m`, otherwise Nothing.
106+ ||| Division by zero is undecidable here and yields Nothing.
107+ public export
108+ decDivides : (n : Nat ) -> (m : Nat ) -> Maybe (Divides n m)
109+ decDivides Z _ = Nothing
110+ decDivides (S k) m =
111+ let q = m `div` (S k) in
112+ case decEq m (q * (S k)) of
113+ Yes prf => Just (DivideBy q prf)
114+ No _ => Nothing
115+
92116||| Round up to next alignment boundary
93117public export
94118alignUp : (size : Nat ) -> (alignment : Nat ) -> Nat
95119alignUp size alignment =
96120 size + paddingFor size alignment
97121
98- ||| Proof that alignUp produces aligned result
122+ ||| Sound divisibility check for an aligned size. The general theorem
123+ ||| "alignUp size align is always divisible by align" needs div/mod lemmas;
124+ ||| here we *decide* it via `decDivides`, which returns a genuine witness when
125+ ||| it holds. (Previously `DivideBy (… div …) Refl`, whose `Refl` cannot
126+ ||| typecheck for symbolic inputs.)
99127public export
100- alignUpCorrect : (size : Nat ) -> (align : Nat ) -> (align > 0) -> Divides align (alignUp size align)
101- alignUpCorrect size align prf =
102- DivideBy (( size + paddingFor size align) `div` align) Refl
128+ alignUpDivides : (size : Nat ) -> (align : Nat ) ->
129+ Maybe (Divides align (alignUp size align))
130+ alignUpDivides size align = decDivides align (alignUp size align)
103131
104132-- ------------------------------------------------------------------------------
105133-- BQN Value Header Layout
@@ -208,6 +236,8 @@ cbqnArrayDescLayout =
208236 ]
209237 16 -- Total size: 16 bytes
210238 8 -- Alignment: 8 bytes
239+ {sizeCorrect = Oh }
240+ {aligned = DivideBy 2 Refl }
211241
212242-- ------------------------------------------------------------------------------
213243-- Platform-Specific Layouts
@@ -229,17 +259,56 @@ verifyAllPlatforms layouts = Right ()
229259-- C ABI Compatibility
230260-- ------------------------------------------------------------------------------
231261
232- ||| Proof that a struct follows C ABI rules
262+ ||| Proof that every field offset in a layout is correctly aligned.
263+ public export
264+ data FieldsAligned : Vect k Field -> Type where
265+ NoFields : FieldsAligned []
266+ ConsField :
267+ (f : Field) ->
268+ (rest : Vect k Field) ->
269+ Divides f.alignment f.offset ->
270+ FieldsAligned rest ->
271+ FieldsAligned (f :: rest)
272+
273+ ||| Decide field alignment for every field, building a real `FieldsAligned`
274+ ||| witness from per-field divisibility proofs.
275+ public export
276+ decFieldsAligned : (fs : Vect k Field) -> Maybe (FieldsAligned fs)
277+ decFieldsAligned [] = Just NoFields
278+ decFieldsAligned (f :: fs) =
279+ case decDivides f. alignment f. offset of
280+ Nothing => Nothing
281+ Just dvd => case decFieldsAligned fs of
282+ Nothing => Nothing
283+ Just rest => Just (ConsField f fs dvd rest)
284+
285+ ||| Proof that a struct layout follows C ABI alignment rules.
233286public export
234287data CABICompliant : StructLayout -> Type where
235288 CABIOk :
236289 (layout : StructLayout) ->
290+ FieldsAligned layout.fields ->
237291 CABICompliant layout
238292
239- ||| Proof that CBQN array descriptor is C-ABI compliant
293+ ||| Verify a layout against the C ABI alignment rules, returning a genuine
294+ ||| `CABICompliant` proof (built from real per-field divisibility witnesses)
295+ ||| or an error when some field offset is misaligned.
296+ public export
297+ checkCABI : (layout : StructLayout) -> Either String (CABICompliant layout)
298+ checkCABI layout =
299+ case decFieldsAligned layout. fields of
300+ Just prf => Right (CABIOk layout prf)
301+ Nothing => Left " Field offsets are not correctly aligned for the C ABI"
302+
303+ ||| Proof that CBQN array descriptor is C-ABI compliant.
304+ ||| Offsets 0 and 8 are both divisible by alignment 8.
240305public export
241- cbqnArrayDescCABI : CABICompliant cbqnArrayDescLayout
242- cbqnArrayDescCABI = CABIOk cbqnArrayDescLayout
306+ cbqnArrayDescCABI : CABICompliant Layout.cbqnArrayDescLayout
307+ cbqnArrayDescCABI =
308+ CABIOk cbqnArrayDescLayout
309+ (ConsField _ _ (DivideBy 0 Refl )
310+ (ConsField _ _ (DivideBy 1 Refl )
311+ NoFields ))
243312
244313-- ------------------------------------------------------------------------------
245314-- Offset Calculation
@@ -252,3 +321,15 @@ fieldOffset layout name =
252321 case findIndex (\ f => f. name == name) layout. fields of
253322 Just idx => Just (finToNat idx ** index idx layout. fields)
254323 Nothing => Nothing
324+
325+ ||| Decide whether a field lies within a struct's byte bounds, returning a
326+ ||| genuine proof when `offset + size <= totalSize`. A previous template
327+ ||| version asserted this for *every* field unconditionally, which is false
328+ ||| (a field need not belong to the layout); this honest version decides it.
329+ public export
330+ offsetInBounds : (layout : StructLayout) -> (f : Field) ->
331+ Maybe (So (f.offset + f.size <= layout.totalSize))
332+ offsetInBounds layout f =
333+ case choose (f. offset + f. size <= layout. totalSize) of
334+ Left ok => Just ok
335+ Right _ => Nothing
0 commit comments