Add offset information to some AST elements.wip

1 files changed, 21 insertions, 23 deletions

diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
index 2172694..903e6f4 100644
--- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
+++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
@@ -55,10 +55,6 @@ consistencyCheckPhase = pureCompilationPhase $ advanceStage ()
 instance AdvanceStage S ObjTypeBody where
   advanceStage () objTypeBody = snd <$> advanceObjTypeBody objTypeBody 0
 
-deriving instance AdvanceStage S DeferredRegisterBody
-
-deriving instance AdvanceStage S RegisterBody
-
 deriving instance AdvanceStage S AnonymousBitsType
 
 deriving instance AdvanceStage S ImportStatement
@@ -75,8 +71,6 @@ deriving instance AdvanceStage S EnumBody
 
 deriving instance AdvanceStage S EnumConstantDecl
 
-deriving instance AdvanceStage S RegisterBitsDecl
-
 deriving instance AdvanceStage S PackageBody
 
 deriving instance AdvanceStage S FiddleDecl
@@ -150,16 +144,16 @@ advanceObjTypeBody (ObjTypeBody us decls a) startOffset = do
                     assertedPos <- expressionToIntM expr
                     checkPositionAssertion (annot e) assertedPos offset
                     return (ret, offset)
-                  (RegisterDecl mod ident size Nothing a) -> do
+                  (RegisterDecl _ mod ident size Nothing a) -> do
                     (sizeExpr, reifiedSize) <- advanceAndGetSize size
-                    doReturn (RegisterDecl mod ident sizeExpr Nothing a)
+                    doReturn (RegisterDecl offset mod ident sizeExpr Nothing a)
                       =<< checkBitsSizeMod8 a reifiedSize
-                  (RegisterDecl mod ident size (Just body) a) -> do
+                  (RegisterDecl _ mod ident size (Just body) a) -> do
                     declaredSize <- expressionToIntM size
                     (actualSize, body') <- advanceRegisterBody body
                     checkSizeMismatch a declaredSize actualSize
                     (sizeExpr, reifiedSize) <- advanceAndGetSize size
-                    doReturn (RegisterDecl mod ident sizeExpr (Just body') a)
+                    doReturn (RegisterDecl offset mod ident sizeExpr (Just body') a)
                       =<< checkBitsSizeMod8 a reifiedSize
                   (ReservedDecl size a) -> do
                     (sizeExpr, reifiedSize) <- advanceAndGetSize size
@@ -182,19 +176,23 @@ advanceRegisterBody :: RegisterBody S F A -> M (Word32, RegisterBody S' F A)
 -- Handle the case where it's a union.
 advanceRegisterBody
   (RegisterBodyPattern us (NonEmpty.nonEmpty -> Just decls) a b) = do
-    decls' <-
-      mapM
-        ( \d -> do
-            (sz, t) <- advanceDecl (undirected d)
-            return (sz, mapDirected (const t) d)
+    (structSize, reverse -> decls') <-
+      foldlM
+        ( \(offset, ret) d -> do
+            (sz, t) <- advanceDecl offset (undirected d)
+            let advanceOffset off sz =
+                  case us of
+                    Union {} -> off
+                    Struct {} -> off + sz
+            return (advanceOffset offset sz, (sz, mapDirected (const t) d) : ret)
         )
+        (0, [])
         decls
     calcSize <- case us of
       Union {} -> do
-        checkJagged (toList decls')
-        return $ maximum (map fst (toList decls'))
-      Struct {} -> do
-        return $ sum (map fst (toList decls'))
+        checkJagged decls'
+        return $ maximum (map fst decls')
+      Struct {} -> return structSize
 
     return (calcSize, RegisterBodyPattern us (map snd $ toList decls') a b)
 
@@ -219,8 +217,8 @@ checkJagged decls = do
         )
         a
 
-advanceDecl :: RegisterBitsDecl S F A -> M (Word32, RegisterBitsDecl S' F A)
-advanceDecl = \case
+advanceDecl :: Word32 -> RegisterBitsDecl S F A -> M (Word32, RegisterBitsDecl S' F A)
+advanceDecl offset = \case
   ReservedBits expr an -> do
     sz <- expressionToIntM expr
     (sz,)
@@ -228,10 +226,10 @@ advanceDecl = \case
               <$> advanceStage () expr
               <*> pure an
           )
-  DefinedBits mod ident typ annot -> do
+  DefinedBits _ mod ident typ annot -> do
     size <- bitsTypeSize typ
     (size,)
-      <$> (DefinedBits mod ident <$> advanceStage () typ <*> pure annot)
+      <$> (DefinedBits offset mod ident <$> advanceStage () typ <*> pure annot)
   BitsSubStructure subBody subName ann -> do
     (sz, body') <- advanceRegisterBody subBody
     return (sz, BitsSubStructure body' subName ann)