bugfix: bit unions and structs should start at correct offset.

The compiler reset the offset to 0 in bitfield substructures.

1 files changed, 8 insertions, 7 deletions

diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
index 3e81153..6a3b5d9 100644
--- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
+++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
@@ -165,7 +165,7 @@ advanceObjTypeBody (ObjTypeBody us decls a) startOffset = do
                       =<< checkBitsSizeMod8 a reifiedSize
                   (RegisterDecl qmeta mod ident size (Just body) a) -> do
                     declaredSize <- expressionToIntM size
-                    (actualSize, body') <- advanceRegisterBody body
+                    (actualSize, body') <- advanceRegisterBody 0 body
 
                     checkSizeMismatch a declaredSize actualSize
 
@@ -190,9 +190,10 @@ pattern RegisterBodyPattern u decls a b = RegisterBody u (Identity (DeferredRegi
 
 -- registerBodyPattern u decls a b = RegisterBody u (Identity (DeferredRegisterBody decls a)) a
 
-advanceRegisterBody :: RegisterBody S F A -> M (N Bits, RegisterBody S' F A)
+advanceRegisterBody :: N Bits -> RegisterBody S F A -> M (N Bits, RegisterBody S' F A)
 -- Handle the case where it's a union.
 advanceRegisterBody
+  startOffset
   (RegisterBodyPattern us (NonEmpty.nonEmpty -> Just decls) a b) = do
     (structSize, reverse -> decls') <-
       foldlM
@@ -204,7 +205,7 @@ advanceRegisterBody
                     Struct {} -> off + sz
             return (advanceOffset offset sz, (sz, mapDirected (const t) d) : ret)
         )
-        (0, [])
+        (startOffset, [])
         decls
     calcSize <- case us of
       Union {} -> do
@@ -215,9 +216,9 @@ advanceRegisterBody
     return (calcSize, RegisterBodyPattern us (map snd $ toList decls') a b)
 
 -- Handle the case where there's no decls.
-advanceRegisterBody (RegisterBodyPattern u _ a b) =
+advanceRegisterBody _ (RegisterBodyPattern u _ a b) =
   return (0, RegisterBodyPattern u [] a b)
-advanceRegisterBody RegisterBody {} = error "GHC not smart enuf"
+advanceRegisterBody _ RegisterBody {} = error "GHC not smart enuf"
 
 checkJagged :: (Annotated t) => [(N u, t f A)] -> Compile s ()
 checkJagged decls = do
@@ -248,11 +249,11 @@ advanceDecl offset = \case
     size <- bitsTypeSize typ
     let span = Present (FieldSpan offset size)
         qmeta' = fmap (\q -> q {bitsSpan = span}) qmeta
-    
+
     (size,)
       <$> (DefinedBits qmeta' mod ident <$> advanceStage () typ <*> pure annot)
   BitsSubStructure subBody subName ann -> do
-    (sz, body') <- advanceRegisterBody subBody
+    (sz, body') <- advanceRegisterBody offset subBody
     return (sz, BitsSubStructure body' subName ann)
 
 bitsTypeSize :: RegisterBitsTypeRef S F A -> M (N Bits)