Add metadata information to the BitsSubStructure and compile it correctly.

1 files changed, 55 insertions, 3 deletions

diff --git a/src/Language/Fiddle/Compiler/Backend/C.hs b/src/Language/Fiddle/Compiler/Backend/C.hs
index 4b4b3ea..1ab22bb 100644
--- a/src/Language/Fiddle/Compiler/Backend/C.hs
+++ b/src/Language/Fiddle/Compiler/Backend/C.hs
@@ -361,6 +361,33 @@ pattern DefinedBitsP modifier bitsName bitsFullPath offset typeRef annot <-
       }
     )
 
+pattern BitsSubstructureP ::
+  Modifier f a ->
+  String ->
+  QualifiedPath String ->
+  N Bits ->
+  N Bits ->
+  RegisterBody Checked f A ->
+  A ->
+  RegisterBitsDecl Checked f A
+pattern BitsSubstructureP modifier bitsName bitsFullPath offset size subRegisterBody annot <-
+  BitsSubStructure
+    { qBitsMetadata =
+        Present
+          QBitsMetadata
+            { bitsSpan =
+                Present
+                  FieldSpan
+                    { offset = offset,
+                      size = size
+                    },
+              bitsFullPath = (basenamePart &&& id -> (bitsName, bitsFullPath))
+            },
+      bitsModifier = (Guaranteed modifier),
+      bitsSubRegBody = subRegisterBody,
+      bitsSubAnnot = annot
+    }
+
 writeBitsGet ::
   StructName ->
   QRegMetadata True ->
@@ -616,13 +643,13 @@ typeRefToArgs reg =
 -- decomposeBitsTypeRef (RegisterBitsJustBits )
 writeRegisterBody ::
   StructName -> QRegMetadata True -> RegisterBody Checked I A -> M SIntf
-writeRegisterBody structName regmeta = execWriterT . walk_ registerWalk
+writeRegisterBody structName regmeta t = execWriterT $ walk (\t' () -> registerWalk t') t ()
   where
     registerWalk ::
       forall t.
       (Walk t, Typeable t) =>
       t I A ->
-      WriterT SIntf (FilesM () FormattedWriter CFileState) ()
+      WriterT SIntf (FilesM () FormattedWriter CFileState) (WalkContinuation ())
     registerWalk t = case () of
       ()
         | (Just (DefinedBitsP modifier _ fullPath offset typeRef annot)) <- castTS t ->
@@ -637,6 +664,31 @@ writeRegisterBody structName regmeta = execWriterT . walk_ registerWalk
                       ( tell =<< lift (writeBitsGet structName regmeta fullPath offset typeRef annot),
                         tell =<< lift (writeBitsSet isWo structName regmeta fullPath offset typeRef annot)
                       )
+                  return Stop
+      () | (Just (BitsSubstructureP modifier bitsName fullPath offset size subBody annot)) <- castTS t -> do
+        sIntf <- lift (writeRegisterBody structName regmeta subBody)
+        let isWo = case modifier of
+              ModifierKeyword Wo _ -> True
+              _ -> False
+        if null bitsName
+          then tell sIntf
+          else do
+            -- Make a typeref here which is defined as "just bitse"
+            let typeRef =
+                  RegisterBitsJustBits
+                    (ConstExpression (LeftV size) annot)
+                    annot
+
+            tell $ sIntfSingleton bitsName sIntf
+            lift $ textM $ emitDocComments annot
+            sequence_ $
+              selectByModifier
+                modifier
+                ( tell =<< lift (writeBitsGet structName regmeta fullPath offset typeRef annot),
+                  tell =<< lift (writeBitsSet isWo structName regmeta fullPath offset typeRef annot)
+                )
+
+        return Stop
       -- text $
       --   Text.pack $
       --     printf
@@ -644,7 +696,7 @@ writeRegisterBody structName regmeta = execWriterT . walk_ registerWalk
       --       bitsName
       --       (qualifiedPathToIdentifier fullPath)
       --       offset
-      _ -> return ()
+      _ -> return $ Continue ()
 
     castTS ::
       forall (t' :: SynTree) (t :: StagedSynTree) (f :: Type -> Type) (a :: Type).