Start implementing a bunch of the C backend.

Have basic implementations down for coarse registers. Working on getting
bitfields supported.

9 files changed, 530 insertions, 157 deletions

diff --git a/src/Language/Fiddle/Ast/Internal/MetaTypes.hs b/src/Language/Fiddle/Ast/Internal/MetaTypes.hs
index ec5948d..296324c 100644
--- a/src/Language/Fiddle/Ast/Internal/MetaTypes.hs
+++ b/src/Language/Fiddle/Ast/Internal/MetaTypes.hs
@@ -9,21 +9,22 @@ module Language.Fiddle.Ast.Internal.MetaTypes
     IsIdentity (..), -- Typeclass for unwrapping values from certain functors
     toMaybe, -- Function for converting a 'When' to a 'Maybe'
     module X, -- Re-exporting some commonly used modules
-    Guaranteed(..),
+    Guaranteed (..),
     guarantee,
     guaranteeM,
     revokeGuarantee,
-    Variant(..),
+    Variant (..),
     foldVariant,
-    toEither
+    toEither,
   )
 where
 
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import Data.Bifunctor
 import Data.Functor.Identity as X
 import Data.List.NonEmpty as X (NonEmpty (..))
 import Data.Maybe (fromMaybe)
-import Data.Bifunctor
-import Data.Aeson (ToJSON(..))
+import Data.Type.Bool (Not)
 
 -- | 'IsMaybe' is a typeclass for converting a general functor into a Maybe.
 class IsMaybe f where
@@ -48,7 +49,7 @@ instance IsIdentity Identity where
 -- the first element of the non-empty list.
 instance IsIdentity NonEmpty where
   unwrap (a :| _) = a
-  wrap = (:|[])
+  wrap = (:| [])
 
 -- | 'Witness' is a type that can only be constructed if the
 -- type-level condition 's' is 'True'. It serves as a proof
@@ -68,6 +69,19 @@ data When (s :: Bool) t where
   Vacant :: When False t -- No value present
   Present :: t -> When True t -- Value is present
 
+instance (ToJSON t) => ToJSON (When s t) where
+  toJSON Vacant = toJSON ()
+  toJSON (Present t) = toJSON t
+
+instance (FromJSON t) => FromJSON (When False t) where
+  parseJSON v = unUnit <$> parseJSON v
+    where
+      unUnit :: () -> When False t
+      unUnit _ = Vacant
+
+instance (FromJSON t) => FromJSON (When True t) where
+  parseJSON v = Present <$> parseJSON v
+
 -- | Instance for converting a 'When' type to a 'Maybe', erasing type-level
 -- information about the presence of the value.
 instance IsMaybe (When s) where
@@ -125,27 +139,30 @@ data Guaranteed (s :: Bool) t where
   --   in a 'Maybe'.
   Guaranteed :: t -> Guaranteed True t
 
--- | 'guaranteeM' takes a monadic action and a 'Guaranteed' value that may or 
--- may not hold a value ('Guaranteed False'). If the input contains a value 
--- ('Perhaps (Just t)'), it simply wraps that value in 'Guaranteed True'. 
--- Otherwise, it performs the monadic action to produce a new value and wraps 
+-- | 'guaranteeM' takes a monadic action and a 'Guaranteed' value that may or
+-- may not hold a value ('Guaranteed False'). If the input contains a value
+-- ('Perhaps (Just t)'), it simply wraps that value in 'Guaranteed True'.
+-- Otherwise, it performs the monadic action to produce a new value and wraps
 -- it in 'Guaranteed True'.
 guaranteeM :: (Monad m) => m t -> Guaranteed False t -> m (Guaranteed True t)
 guaranteeM _ (Perhaps (Just t)) = return (Guaranteed t)
 guaranteeM act _ = Guaranteed <$> act
 
--- | 'guarantee' converts a 'Guaranteed False' value to 'Guaranteed True', 
--- providing a fallback value. If the original 'Guaranteed False' value 
+-- | 'guarantee' converts a 'Guaranteed False' value to 'Guaranteed True',
+-- providing a fallback value. If the original 'Guaranteed False' value
 -- contains a value, that value is used. Otherwise, the fallback value is used.
 guarantee :: t -> Guaranteed False t -> Guaranteed True t
 guarantee v = Guaranteed . fromMaybe v . toMaybe
 
--- | 'revokeGuarantee' converts a 'Guaranteed True' value back to 
--- 'Guaranteed False'. It wraps the contained value in 'Perhaps' to indicate 
+-- | 'revokeGuarantee' converts a 'Guaranteed True' value back to
+-- 'Guaranteed False'. It wraps the contained value in 'Perhaps' to indicate
 -- that the guarantee is no longer present.
 revokeGuarantee :: Guaranteed True t -> Guaranteed False t
 revokeGuarantee = Perhaps . toMaybe
 
+ofVariant :: Variant b (Maybe t) t -> Guaranteed (Not b) t
+ofVariant (LeftV l) = Perhaps l
+ofVariant (RightV r) = Guaranteed r
 
 instance Functor (Guaranteed s) where
   fmap _ (Perhaps Nothing) = Perhaps Nothing
@@ -181,7 +198,7 @@ instance IsIdentity (Guaranteed True) where
 --   'ifTrue' when the type-level boolean 'b' is 'True', or a value of type
 --   'ifFalse' when 'b' is 'False'.
 --
---   This data type allows encoding conditional behavior at the type level, 
+--   This data type allows encoding conditional behavior at the type level,
 --   where the actual type stored depends on a compile-time boolean. It provides
 --   a way to handle cases where certain fields or structures may vary based on
 --   type-level conditions.
@@ -198,7 +215,6 @@ data Variant (b :: Bool) ifTrue ifFalse where
   -- | Constructor for the 'Variant' when the type-level boolean is 'True'. It
   --   stores a value of type 'ifTrue'.
   LeftV :: ifTrue -> Variant True ifTrue ifFalse
-
   -- | Constructor for the 'Variant' when the type-level boolean is 'False'. It
   --   stores a value of type 'ifFalse'.
   RightV :: ifFalse -> Variant False ifTrue ifFalse
@@ -216,14 +232,20 @@ instance Functor (Variant b t) where
 
 instance Foldable (Variant b t) where
   foldMap f t = foldMap f (toEither t)
-  
+
 instance Bifunctor (Variant b) where
   bimap fl _ (LeftV l) = LeftV (fl l)
   bimap _ fr (RightV r) = RightV (fr r)
-  
+
 instance IsIdentity (Variant False t) where
   unwrap (RightV r) = r
   wrap = RightV
 
 instance (ToJSON f, ToJSON t) => ToJSON (Variant s t f) where
   toJSON = foldVariant toJSON toJSON
+
+instance (FromJSON t) => FromJSON (Variant True t f) where
+  parseJSON v = LeftV <$> parseJSON v
+
+instance (FromJSON f) => FromJSON (Variant False t f) where
+  parseJSON v = RightV <$> parseJSON v
diff --git a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
index ec62c84..5a8aa6d 100644
--- a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
+++ b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
@@ -14,8 +14,10 @@ module Language.Fiddle.Ast.Internal.SyntaxTree
     RegisterOffset,
     BitsOffset,
     QMd,
-    NamedUnit(..),
+    NamedUnit (..),
     FieldSpan (..),
+    QRegMetadata (..),
+    QBitsMetadata (..),
     -- Witness Types
     Witness (..),
     -- AST Types
@@ -81,6 +83,38 @@ data FieldSpan u where
     FieldSpan u
   deriving (Eq, Ord, Show, Generic, ToJSON, FromJSON)
 
+-- | Metadata about a register.
+data QRegMetadata (checkStage :: Bool) where
+  QRegMetadata ::
+    { -- | The span of the register. Only reified in the Check stage.
+      regSpan :: When checkStage (FieldSpan Bytes),
+      -- | Is this a reified "reserved" register?
+      regIsPadding :: Bool,
+      -- | Was this register unnamed? This implies that the register should not
+      -- emit getters and setters.
+      regIsUnnamed :: Bool,
+      -- | Full path to the register.
+      regFullPath :: NonEmpty String
+    } ->
+    QRegMetadata checkStage
+  deriving (Generic, ToJSON)
+
+deriving instance
+  (FromJSON (When s (FieldSpan Bytes))) =>
+  FromJSON (QRegMetadata s)
+
+data QBitsMetadata (checkStage :: Bool) where
+  QBitsMetadata ::
+    { bitsSpan :: When checkStage (FieldSpan Bits),
+      bitsFullPath :: NonEmpty String
+    } ->
+    QBitsMetadata checkStage
+  deriving (Generic, ToJSON)
+
+deriving instance
+  (FromJSON (When s (FieldSpan Bits))) =>
+  FromJSON (QBitsMetadata s)
+
 type BitsOffset stage = RegisterOffset stage
 
 -- | Type used for the RegisterOffset type. This is populated in the check
@@ -461,9 +495,9 @@ data ObjTypeDecl stage f a where
   RegisterDecl ::
     { -- | Offset within the register. Calculated during the consistency check.
       -- The offset is calculated from the top-level structure.
-      regSpan :: When (stage .>= Checked) (FieldSpan Bytes),
+      qRegMeta :: When (stage .>= Qualified) (QRegMetadata (stage .>= Checked)),
       -- | Optional register modifier.
-      regModifier :: Maybe (Modifier f a),
+      regModifier :: Guaranteed (stage .>= Qualified) (Modifier f a),
       -- | Optional register identifier. This is guaranteed to exist after
       -- Qualification, where a generated identifier will be provided if it
       -- doesn't exist.
@@ -478,10 +512,8 @@ data ObjTypeDecl stage f a where
     ObjTypeDecl stage f a
   -- | A reserved declaration for padding or alignment.
   ReservedDecl ::
-    { -- | Offset and size of this reserved block.
-      regSpan :: When (stage .>= Checked) (FieldSpan Bytes),
-      -- | Generated identifier for this reserved field.
-      reservedIdent :: When (stage .>= Qualified) String,
+    { -- | Reserved "registers" should be reified in the qualification phase.
+      noReservedAfterQualification :: Witness (stage .< Qualified),
       -- | The expression for reserved space.
       reservedExpr :: Expression Bits stage f a,
       -- | Annotation for the reserved declaration.
@@ -512,7 +544,7 @@ data Modifier f a where
   deriving (Generic, Annotated, Alter, Typeable, Walk)
 
 -- | Enumerates the different types of register modifiers.
-data ModifierKeyword = Rw | Ro | Wo
+data ModifierKeyword = Rw | Ro | Wo | Pr
   deriving (Eq, Ord, Show, Read, Typeable)
 
 -- | Represents a deferred register body, consisting of a list of bit
@@ -568,7 +600,7 @@ data RegisterBitsDecl stage f a where
   DefinedBits ::
     { -- | The offset for these bits. This is calculated during the
       -- ConsistencyCheck phase, so until this phase it's just ().
-      definedBitsSpan :: When (stage .>= Checked) (FieldSpan Bits),
+      qBitsMetadata :: When (stage .>= Qualified) (QBitsMetadata (stage .>= Checked)),
       -- | Bit declarations.
       -- | Optional modifier for the bits.
       definedBitsModifier :: Maybe (Modifier f a),
diff --git a/src/Language/Fiddle/Compiler/Backend.hs b/src/Language/Fiddle/Compiler/Backend.hs
index ddb32c6..eda3ede 100644
--- a/src/Language/Fiddle/Compiler/Backend.hs
+++ b/src/Language/Fiddle/Compiler/Backend.hs
@@ -25,13 +25,6 @@ instance Semigroup TranspileResult where
 instance Monoid TranspileResult where
   mempty = TranspileResult mempty
 
--- | "Opens" a file in the broader context of a TransplieResult, and writes the
--- resulting bytestring to it
-withFile ::
-  (MonadWriter TranspileResult m) => FilePath -> Writer Text () -> m ()
-withFile path bsWriter =
-  tell (TranspileResult $ Map.singleton path $ execWriter bsWriter)
-
 -- | A backend for the FiddleCompiler. Takes a Checked FiddleUnit and emits
 -- generated code for that fiddle unit.
 data Backend where
diff --git a/src/Language/Fiddle/Compiler/Backend/C.hs b/src/Language/Fiddle/Compiler/Backend/C.hs
index 645fa85..9dbbec6 100644
--- a/src/Language/Fiddle/Compiler/Backend/C.hs
+++ b/src/Language/Fiddle/Compiler/Backend/C.hs
@@ -1,27 +1,36 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Language.Fiddle.Compiler.Backend.C (cBackend) where
 
-import Control.Arrow (Arrow (second))
+import Control.Arrow
+import Control.Monad (unless)
 import Control.Monad.RWS
+import Control.Monad.State (State)
+import Control.Monad.Trans.Writer (Writer, execWriter)
 import Data.Char (isSpace)
 import Data.Data (Typeable, cast)
 import Data.Foldable (forM_, toList)
 import Data.Kind (Type)
+import qualified Data.List.NonEmpty as NonEmpty
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Set (Set)
+import qualified Data.Set as Set
 import Data.String (IsString)
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Language.Fiddle.Ast
 import Language.Fiddle.Compiler.Backend
 import Language.Fiddle.Internal.UnitInterface
+import Language.Fiddle.Internal.UnitNumbers
 import Language.Fiddle.Types
 import Options.Applicative
+import Text.Printf (printf)
 
 data ImplementationInHeader = ImplementationInHeader
 
@@ -30,17 +39,31 @@ data CBackendFlags = CBackendFlags
     cHeaderOut :: FilePath
   }
 
-newtype FilePosition = FilePosition Int
+type StructName = Text
+
+newtype Fragment = Fragment Int
   deriving (Eq, Ord)
 
-headerPos :: FilePosition
-headerPos = FilePosition 0
+-- | Header fragment. The top. Starts which include guards and has include
+-- statements.
+hF :: Fragment
+hF = Fragment 0
+
+-- | Structures fragment. The text fragment where structures are defined.
+sF :: Fragment
+sF = Fragment 25
+
+-- | Implementation fragment. This is where function implementations go.
+iF :: Fragment
+iF = Fragment 75
 
-middlePos :: FilePosition
-middlePos = FilePosition 50
+-- | Assert fragment. This is where static asserts go.
+aF :: Fragment
+aF = Fragment 50
 
-footerPos :: FilePosition
-footerPos = FilePosition 100
+-- | Footer fragment. This is wehre the file include endif goes.
+fF :: Fragment
+fF = Fragment 100
 
 tellLn :: (MonadWriter Text m) => Text -> m ()
 tellLn s = tell s >> tell "\n"
@@ -49,8 +72,10 @@ type A = Commented SourceSpan
 
 type I = Identity
 
--- | Current local state information while traversing the tree.
 data St = St
+
+-- | Current local state information while traversing the tree.
+data Fmt = Fmt
   { indentLevel :: Int,
     pendingLine :: Text
   }
@@ -58,16 +83,16 @@ data St = St
 newtype M a = M {unM :: RWS () () (St, Files) a}
   deriving newtype (Functor, Applicative, Monad, MonadState (St, Files))
 
-newtype FormattedWriter a = FormattedWriter (RWS () Text St a)
-  deriving newtype (Functor, Applicative, Monad, MonadState St)
+newtype FormattedWriter a = FormattedWriter (RWS () Text Fmt a)
+  deriving newtype (Functor, Applicative, Monad, MonadState Fmt)
 
-indented :: FormattedWriter a -> FormattedWriter a
+indented :: FileM a -> FileM a
 indented fn = do
-  modify (\(St id p) -> St (id + 1) p)
-  fn <* modify (\(St id p) -> St (id - 1) p)
+  textM (modify (\(Fmt id p) -> Fmt (id + 1) p))
+  fn <* textM (modify (\(Fmt id p) -> Fmt (id - 1) p))
 
 execFormattedWriter :: FormattedWriter a -> Text
-execFormattedWriter ((>> flush) -> FormattedWriter rws) = snd $ execRWS rws () (St 0 "")
+execFormattedWriter ((>> flush) -> FormattedWriter rws) = snd $ execRWS rws () (Fmt 0 "")
 
 flush :: FormattedWriter ()
 flush = do
@@ -75,23 +100,68 @@ flush = do
   modify $ \s -> s {pendingLine = ""}
   tell p
 
-data Files = Files
-  { filepaths :: Map FilePath (Map FilePosition (FormattedWriter ()))
+newtype FileFragments = FileFragments (Map Fragment (FormattedWriter ()))
+
+instance Semigroup FileFragments where
+  (FileFragments m1) <> (FileFragments m2) = FileFragments (Map.unionWith (>>) m1 m2)
+
+instance Monoid FileFragments where
+  mempty = FileFragments mempty
+
+newtype CFileState = CFileState
+  { includedFiles :: Set String
   }
 
-withFileAt :: FilePath -> FilePosition -> FormattedWriter () -> M ()
-withFileAt fp pos wr = do
+newtype FileM a = FileM {unFileM :: RWS Fragment FileFragments CFileState a}
+  deriving newtype (Functor, Applicative, Monad, MonadWriter FileFragments, MonadReader Fragment, MonadState CFileState)
+
+execFileM :: FileM a -> Text
+execFileM fm =
+  let (_, FileFragments mp) = execRWS (unFileM fm) hF (CFileState mempty)
+   in ( execFormattedWriter
+          . sequence_
+          . Map.elems
+      )
+        mp
+
+requireInclude :: String -> FileM ()
+requireInclude file = do
+  b <- (Set.member file) <$> gets includedFiles
+  unless b $ do
+    under hF $
+      text $
+        Text.pack $
+          printf "#include <%s>\n" file
+    modify $ \s -> s {includedFiles = Set.insert file (includedFiles s)}
+
+-- | Writes text to the current fragment context
+text :: Text -> FileM ()
+text t = flip tellF_ t =<< ask
+
+-- | Writes text to the current fragment context
+textM :: FormattedWriter () -> FileM ()
+textM t = flip tellFM_ t =<< ask
+
+-- | Executes a file monad within a different fragment.
+under :: Fragment -> FileM () -> FileM ()
+under fr = local (const fr)
+
+tellF_ :: Fragment -> Text -> FileM ()
+tellF_ fp txt = tell $ FileFragments $ Map.singleton fp (tell txt)
+
+tellFM_ :: Fragment -> FormattedWriter () -> FileM ()
+tellFM_ fp txtM = tell $ FileFragments $ Map.singleton fp txtM
+
+newtype Files = Files
+  { filepaths :: Map FilePath (FileM ())
+  }
+
+withFile :: FilePath -> FileM () -> M ()
+withFile fp fn = do
   modify
     ( second $ \(Files {filepaths = fps}) ->
         Files
-          { filepaths =
-              Map.alter
-                ( \(fromMaybe mempty -> posMap) ->
-                    Just $
-                      Map.alter (Just . (>> wr) . fromMaybe (return ())) pos posMap
-                )
-                fp
-                fps
+          { filepaths = Map.alter (Just . (>> fn) . fromMaybe (return ())) fp fps
           }
     )
 
@@ -106,7 +176,7 @@ instance MonadWriter Text FormattedWriter where
       tell pending
       tell line
       tell "\n"
-    modify $ \s -> s {pendingLine = last lines}
+    modify $ \s -> s {pendingLine = pendingLine s <> last lines}
 
   listen (FormattedWriter fn) = FormattedWriter $ listen fn
 
@@ -143,13 +213,7 @@ cBackend =
 
 toTranspileResult :: Files -> TranspileResult
 toTranspileResult Files {filepaths = fps} =
-  TranspileResult $
-    fmap
-      ( execFormattedWriter
-          . sequence_
-          . Map.elems
-      )
-      fps
+  TranspileResult $ fmap execFileM fps
 
 transpile ::
   CBackendFlags ->
@@ -162,21 +226,28 @@ transpile
       cSourceOut = sourceFile
     }
   ()
-  fiddleUnit = toTranspileResult . snd . fst $ execRWS (unM run) () (St 0 "", Files mempty)
+  fiddleUnit = toTranspileResult . snd . fst $ execRWS (unM run) () (St, Files mempty)
     where
       run :: M ()
       run = do
-        withFileAt headerFile headerPos $ do
-          tell $ "#ifndef " <> headerGuard <> "\n"
-          tell $ "#define " <> headerGuard <> "\n"
+        withFile headerFile $ do
+          textM $ do
+            tell $ "#ifndef " <> headerGuard <> "\n"
+            tell $ "#define " <> headerGuard <> "\n\n"
+            tell "#include <stdint.h>\n"
+
+          -- Pad out the implementation
+          under iF $ text "\n"
 
         walk (transpileWalk sourceFile headerFile) fiddleUnit ()
-        withFileAt headerFile footerPos $ tell headerFinal
 
-        withFileAt headerFile headerPos $ do
-          tell "\n#include <stdint.h>\n"
+        withFile headerFile $ do
+          under hF $
+            textM $ do
+              tell "\nstatic_assert(true); // https://github.com/clangd/clangd/issues/1167\n"
 
-          tell "\nstatic_assert(true); // https://github.com/clangd/clangd/issues/1167\n"
+          under fF $
+            text headerFinal
 
       headerFinal = "\n#endif /* " <> headerGuard <> " */\n"
 
@@ -208,43 +279,210 @@ ensureNL = do
       tell p
       tell "\n"
 
-pad :: (IsString t, MonadWriter t m) => m a -> m a
-pad f = tell "\n" *> f <* tell "\n"
+pad :: FileM () -> FileM ()
+pad f = text "\n" *> f <* text "\n"
+
+writeStaticAssert :: Text -> String -> N Bytes -> FileM ()
+writeStaticAssert structName regname off = do
+  requireInclude "stddef.h"
+  text $
+    Text.pack $
+      printf
+        "\n_Static_assert(offsetof(%s, %s) == 0x%x, \"Offset wrong\");\n"
+        structName
+        regname
+        off
+
+sizeToType :: N Bytes -> Maybe String
+sizeToType = \case
+  1 -> Just "uint8_t"
+  2 -> Just "uint16_t"
+  4 -> Just "uint32_t"
+  8 -> Just "uint64_t"
+  _ -> Nothing
+
+selectByModifier :: Modifier f an -> (a, a) -> [a]
+selectByModifier mod (getter, setter) =
+  case mod of
+    (ModifierKeyword Rw _) -> [getter, setter]
+    (ModifierKeyword Ro _) -> [getter]
+    (ModifierKeyword Wo _) -> [setter]
+    (ModifierKeyword Pr _) -> []
+
+writeRegGet :: StructName -> QRegMetadata True -> FileM ()
+writeRegGet
+  structType
+  ( QRegMetadata
+      { regSpan =
+          Present
+            FieldSpan
+              { size = size
+              },
+        regFullPath = fullPath
+      }
+    ) = do
+    let fnName = "get_" <> qualifiedPathToIdentifier fullPath
+        returnType = sizeToType size
+        fieldName = NonEmpty.last fullPath
+
+    case returnType of
+      Just rt -> do
+        textM $ do
+          tell $
+            Text.pack $
+              printf "static inline %s %s(const %s* o) {\n" rt fnName structType
+          tell $ Text.pack $ printf "  return o->%s;\n" fieldName
+          tell "}\n\n"
+      Nothing ->
+        -- Return type is not defined, fallback to byte-by-byte copy.
+        textM $ do
+          tell $
+            Text.pack $
+              printf
+                "static inline void %s(%s* o, uint8_t out[%d]) {\n"
+                fnName
+                structType
+                size
+          forM_ [0 .. size - 1] $ \i ->
+            tell $ Text.pack $ printf "  out[%d] = o->%s[%d];\n" i fieldName i
+          tell "}\n\n"
+
+writeRegSet :: StructName -> QRegMetadata True -> FileM ()
+writeRegSet
+  structType
+  ( QRegMetadata
+      { regSpan =
+          Present
+            FieldSpan
+              { size = size
+              },
+        regFullPath = fullPath
+      }
+    ) = do
+    let fnName = "set_" <> qualifiedPathToIdentifier fullPath
+        setType = sizeToType size
+        fieldName = NonEmpty.last fullPath
+
+    case setType of
+      Just rt -> do
+        textM $ do
+          tell $
+            Text.pack $
+              printf "static inline void %s(%s* o, %s v) {\n" fnName structType rt
+          tell $ Text.pack $ printf "  o->%s = v;\n" fieldName
+          tell "}\n\n"
+      Nothing ->
+        -- Return type is not defined, fallback to byte-by-byte copy.
+        textM $ do
+          tell $
+            Text.pack $
+              printf
+                "static inline void %s(%s* o, const uint8_t in[%d]) {\n"
+                fnName
+                structType
+                size
+          forM_ [0 .. size - 1] $ \i ->
+            tell $ Text.pack $ printf "  o->%s[%d] = in[%d];\n" fieldName i i
+          tell "}\n\n"
+
+pattern DefinedBitsP :: String -> NonEmpty String -> N Bits -> RegisterBitsDecl Checked f a
+pattern DefinedBitsP bitsName bitsFullPath offset <-
+  ( DefinedBits
+      { qBitsMetadata =
+          Present
+            QBitsMetadata
+              { bitsSpan =
+                  Present
+                    FieldSpan
+                      { offset = offset
+                      },
+                bitsFullPath = (NonEmpty.last &&& id -> (bitsName, bitsFullPath))
+              }
+      }
+    )
+
+writeRegisterBody :: StructName -> QRegMetadata True -> RegisterBody Checked I A -> FileM ()
+writeRegisterBody structName regmeta = walk_ registerWalk
+  where
+    registerWalk :: forall t. (Walk t, Typeable t) => t I A -> FileM ()
+    registerWalk t = case () of
+      ()
+        | (Just (DefinedBitsP bitsName fullPath offset)) <- castTS t ->
+            text $
+              Text.pack $
+                printf
+                  "// Emit bits %s (%s) at %d\n"
+                  bitsName
+                  (qualifiedPathToIdentifier fullPath)
+                  offset
+      _ -> return ()
 
-structBody :: ObjTypeBody Checked I A -> FormattedWriter ()
-structBody (ObjTypeBody _ decls _) = do
+    castTS ::
+      forall (t' :: SynTree) (t :: StagedSynTree) (f :: Type -> Type) (a :: Type).
+      ( Typeable t',
+        Typeable t,
+        Typeable f,
+        Typeable a
+      ) =>
+      t' f a ->
+      Maybe (t Checked f a)
+    castTS = cast
+
+writeImplementation ::
+  StructName ->
+  QRegMetadata True ->
+  Modifier f a ->
+  Maybe (RegisterBody Checked I A) ->
+  FileM ()
+
+-- | Register is just padding, don't emit anything
+writeImplementation _ (regIsPadding -> True) _ _ = return ()
+writeImplementation structName qMeta mod bod = do
+  unless (regIsUnnamed qMeta) $
+    sequence_ $
+      selectByModifier mod (writeRegGet structName qMeta, writeRegSet structName qMeta)
+
+  mapM_ (writeRegisterBody structName qMeta) bod
+
+structBody :: StructName -> ObjTypeBody Checked I A -> FileM ()
+structBody structName (ObjTypeBody _ decls _) = do
   forM_ decls $ \(Directed _ decl _) ->
     case decl of
       RegisterDecl
-        { regSpan = Present (FieldSpan _ sz),
+        { qRegMeta = Present regMetadata,
           regIdent = Guaranteed (identToString -> i),
+          regModifier = Guaranteed mod,
+          regBody = bod,
           regAnnot = ann
         } -> do
-          emitDocComments ann
-          tell (sizeToField i sz)
-          tell ";\n"
-      ReservedDecl
-        { regSpan = Present (FieldSpan _ sz),
-          reservedIdent = Present i,
-          reservedAnnot = ann
-        } -> do
-          emitDocComments ann
-          tell (sizeToField i sz)
-          tell ";\n"
+          let (Present (FieldSpan off sz)) = regSpan regMetadata
+
+          textM $ do
+            emitDocComments ann
+            tell (sizeToField i sz)
+            tell ";\n"
+
+          under aF $
+            writeStaticAssert structName i off
+
+          under iF $
+            writeImplementation structName regMetadata mod bod
       TypeSubStructure
         { subStructureBody = Identity bod,
           subStructureName = mname
         } -> do
-          tell $ case objBodyType bod of
-            Union {} -> "union "
-            Struct {} -> "struct "
+          text $
+            case objBodyType bod of
+              Union {} -> "union "
+              Struct {} -> "struct "
 
-          body $ structBody bod
+          body $ structBody structName bod
 
-          forM_ mname $ \name ->
-            tell (Text.pack $ identToString name)
+          textM $ do
+            forM_ mname $ \name ->
+              tell (Text.pack $ identToString name)
 
-          tell ";\n"
+            tell ";\n"
   where
     sizeToField (Text.pack -> f) = \case
       1 -> "volatile uint8_t " <> f
@@ -253,24 +491,24 @@ structBody (ObjTypeBody _ decls _) = do
       8 -> "volatile uint64_t " <> f
       n -> "volatile uint8_t " <> f <> "[" <> Text.pack (show n) <> "]"
 
-union :: Text -> FormattedWriter () -> FormattedWriter ()
+union :: Text -> FileM () -> FileM ()
 union identifier fn = do
-  tell "#pragma pack(push, 1)\n"
-  tell $ "union " <> identifier <> " "
+  text "#pragma pack(push, 1)\n"
+  text $ "union " <> identifier <> " "
   body fn
-  tell ";\n"
-  tell "#pragma pack(pop)\n"
+  text ";\n"
+  text "#pragma pack(pop)\n"
 
-struct :: Text -> FormattedWriter () -> FormattedWriter ()
+struct :: Text -> FileM () -> FileM ()
 struct identifier fn = do
-  tell "#pragma pack(push, 1)\n"
-  tell $ "struct " <> identifier <> " "
+  text "#pragma pack(push, 1)\n"
+  text $ "struct " <> identifier <> " "
   body fn
-  tell ";\n"
-  tell "#pragma pack(pop)\n"
+  text ";\n"
+  text "#pragma pack(pop)\n"
 
-body :: FormattedWriter a -> FormattedWriter a
-body f = tell "{\n" *> indented f <* (ensureNL >> tell "}")
+body :: FileM a -> FileM a
+body f = text "{\n" *> indented f <* textM (ensureNL >> tell "}")
 
 identifierFor :: (ExportableDecl d) => d -> Text
 identifierFor = qualifiedPathToIdentifier . metadataFullyQualifiedPath . getMetadata
@@ -313,14 +551,29 @@ transpileWalk _ headerFile t _ = case () of
               Union {} -> union
               Struct {} -> struct
 
-        withFileAt headerFile middlePos $ do
-          pad $ do
-            emitDocComments a
-            structureType (identifierFor (unwrap metadata)) $ do
-              structBody objTypeBody
+        withFile headerFile $ do
+          under sF $ do
+            pad $ do
+              textM $ emitDocComments a
+              let structName = identifierFor (unwrap metadata)
+              structureType structName $ do
+                structBody structName objTypeBody
         return Stop
+  () | Just (getExportedObjectDecl -> Just e) <- castTS t -> do
+    let qname = qualifiedPathToIdentifier (metadataFullyQualifiedPath (getMetadata e))
+    withFile headerFile $
+      under fF $ do
+        text "#define "
+        text qname
+        text $ Text.pack $ printf " ((%s*)0x%08x)\n" (toLiteralTypeName (exportedObjectDeclType e)) (exportedObjectDeclLocation e)
+
+    return Stop
   _ -> return (Continue ())
   where
+    toLiteralTypeName :: ReferencedObjectType -> Text
+    toLiteralTypeName (ReferencedObjectType str) = qualifiedPathToIdentifier str
+    toLiteralTypeName (ArrayObjectType ro _) = toLiteralTypeName ro
+
     castTS ::
       forall (t' :: SynTree) (t :: StagedSynTree) (f :: Type -> Type) (a :: Type).
       ( Typeable t',
@@ -331,3 +584,7 @@ transpileWalk _ headerFile t _ = case () of
       t' f a ->
       Maybe (t Checked f a)
     castTS = cast
+
+    getExportedObjectDecl :: FiddleDecl Checked I A -> Maybe ExportedObjectDecl
+    getExportedObjectDecl (ObjectDecl {objectQualificationMetadata = Identity (Present decl)}) = Just decl
+    getExportedObjectDecl _ = Nothing
diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
index 4be2912..3d95ea0 100644
--- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
+++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
@@ -153,14 +153,15 @@ 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 qmeta mod ident size Nothing a) -> do
                     (sizeExpr, reifiedSize) <- advanceAndGetSize size
                     reifiedSizeBytes <- checkBitsSizeMod8 a reifiedSize
 
                     let span = Present (FieldSpan offset reifiedSizeBytes)
-                    doReturn (RegisterDecl span mod ident sizeExpr Nothing a)
+                        qmeta' = fmap (\q -> q {regSpan = span}) qmeta
+                    doReturn (RegisterDecl qmeta' mod ident sizeExpr Nothing a)
                       =<< checkBitsSizeMod8 a reifiedSize
-                  (RegisterDecl _ mod ident size (Just body) a) -> do
+                  (RegisterDecl qmeta mod ident size (Just body) a) -> do
                     declaredSize <- expressionToIntM size
                     (actualSize, body') <- advanceRegisterBody body
 
@@ -170,12 +171,8 @@ advanceObjTypeBody (ObjTypeBody us decls a) startOffset = do
                     reifiedSizeBytes <- checkBitsSizeMod8 a reifiedSize
 
                     let span = Present (FieldSpan offset reifiedSizeBytes)
-                    doReturn (RegisterDecl span mod ident sizeExpr (Just body') a) reifiedSizeBytes
-                  (ReservedDecl _ i size a) -> do
-                    (sizeExpr, reifiedSize) <- advanceAndGetSize size
-                    reifiedSizeBytes <- checkBitsSizeMod8 a reifiedSize
-                    let span = Present (FieldSpan offset reifiedSizeBytes)
-                    doReturn (ReservedDecl span i sizeExpr a) reifiedSizeBytes
+                        qmeta' = fmap (\q -> q {regSpan = span}) qmeta
+                    doReturn (RegisterDecl qmeta' mod ident sizeExpr (Just body') a) reifiedSizeBytes
                   (TypeSubStructure (Identity body) name a) -> do
                     (size, body') <- advanceObjTypeBody body offset
                     doReturn (TypeSubStructure (Identity body') name a) size
@@ -245,11 +242,13 @@ advanceDecl offset = \case
               <$> advanceStage () expr
               <*> pure an
           )
-  DefinedBits _ mod ident typ annot -> do
+  DefinedBits qmeta mod ident typ annot -> do
     size <- bitsTypeSize typ
     let span = Present (FieldSpan offset size)
+        qmeta' = fmap (\q -> q {bitsSpan = span}) qmeta
+    
     (size,)
-      <$> (DefinedBits span mod ident <$> advanceStage () typ <*> pure annot)
+      <$> (DefinedBits qmeta' mod ident <$> advanceStage () typ <*> pure annot)
   BitsSubStructure subBody subName ann -> do
     (sz, body') <- advanceRegisterBody subBody
     return (sz, BitsSubStructure body' subName ann)
diff --git a/src/Language/Fiddle/Compiler/Qualification.hs b/src/Language/Fiddle/Compiler/Qualification.hs
index ce6250a..67d3f29 100644
--- a/src/Language/Fiddle/Compiler/Qualification.hs
+++ b/src/Language/Fiddle/Compiler/Qualification.hs
@@ -12,11 +12,11 @@ module Language.Fiddle.Compiler.Qualification (qualificationPhase) where
 
 import Control.Monad.RWS (MonadWriter (tell))
 import Control.Monad.State
-import Data.Foldable (foldlM)
+import Data.Foldable (foldlM, toList)
 import Data.List (intercalate)
-import Data.List.NonEmpty (NonEmpty (..), toList)
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NonEmpty
-import Data.Maybe (mapMaybe)
+import Data.Maybe (isNothing, mapMaybe)
 import qualified Data.Text
 import Data.Word
 import Language.Fiddle.Ast
@@ -52,11 +52,8 @@ uniqueString prefix = do
   modify $ \g -> g {uniqueCounter = cnt + 1}
   return $ "_" ++ prefix ++ show cnt
 
-uniqueIdentifier :: a -> M (Identifier F a)
-uniqueIdentifier a = (\s -> Identifier (Data.Text.pack s) a) <$> uniqueString "ident"
-
-uniqueReservedIdentifier :: a -> M (Identifier F a)
-uniqueReservedIdentifier a = (\s -> Identifier (Data.Text.pack s) a) <$> uniqueString "reserved"
+uniqueIdentifier :: String -> a -> M (Identifier F a)
+uniqueIdentifier prefix a = (\s -> Identifier (Data.Text.pack s) a) <$> uniqueString prefix
 
 instance CompilationStage Expanded where
   type StageAfter Expanded = Qualified
@@ -77,14 +74,17 @@ qualificationPhase =
 
     squeezeDiagnostics raw
 
--- Any non-guaranteed identifiers are given generated identifiers here.
-instance
-  StageConvertible
-    Expanded
-    (Guaranteed False (Identifier F A))
-    (Guaranteed True (Identifier F A))
-  where
-  convertInStage _ ann _ = guaranteeM (uniqueIdentifier ann)
+pushIdent :: Identifier f a -> LocalState -> LocalState
+pushIdent i = pushIdents [i]
+
+pushIdents :: (Foldable t) => t (Identifier f a) -> LocalState -> LocalState
+pushIdents =
+  ( \case
+      [] -> id
+      (i : is) ->
+        modifyCurrentScopePath (pushScope $ fmap identToString (i :| is))
+  )
+    . toList
 
 instance
   StageConvertible
@@ -110,9 +110,80 @@ deriving instance AdvanceStage S EnumBody
 
 deriving instance AdvanceStage S EnumConstantDecl
 
-deriving instance AdvanceStage S RegisterBitsDecl
-
-deriving instance AdvanceStage S ObjTypeDecl
+instance AdvanceStage S RegisterBitsDecl where
+  advanceStage localState = \case
+    ReservedBits expr an -> ReservedBits <$> advanceStage localState expr <*> pure an
+    BitsSubStructure bod name an ->
+      BitsSubStructure
+        <$> advanceStage localState bod
+        <*> pure name
+        <*> pure an
+    DefinedBits _ mod ident typ an -> do
+      let qMeta =
+            QBitsMetadata
+              { bitsSpan = Vacant,
+                bitsFullPath =
+                  qualifyPath
+                    (currentScopePath localState)
+                    (NonEmpty.singleton (identToString ident))
+              }
+      DefinedBits (Present qMeta) mod ident
+        <$> advanceStage localState typ
+        <*> pure an
+
+instance AdvanceStage S ObjTypeDecl where
+  advanceStage localState = \case
+    AssertPosStatement d e a ->
+      AssertPosStatement d <$> advanceStage localState e <*> pure a
+    RegisterDecl _ mod ident size bod ann -> do
+      ident' <- guaranteeM (uniqueIdentifier "reg" ann) ident
+      let localState' = pushIdents ident localState
+
+      let qRegMeta =
+            QRegMetadata
+              { regSpan = Vacant,
+                regIsPadding = False,
+                regIsUnnamed = isNothing (toMaybe ident),
+                regFullPath =
+                  qualifyPath
+                    (currentScopePath localState)
+                    (NonEmpty.singleton (identToString (unwrap ident')))
+              }
+
+      RegisterDecl
+        (Present qRegMeta)
+        (guarantee (ModifierKeyword Rw ann) mod)
+        ident'
+        <$> advanceStage localState' size
+        <*> mapM (advanceStage localState') bod
+        <*> pure ann
+    ReservedDecl _ expr ann -> do
+      ident <- uniqueIdentifier "reserved" ann
+
+      let qRegMeta =
+            QRegMetadata
+              { regSpan = Vacant,
+                regIsPadding = True,
+                regIsUnnamed = True,
+                regFullPath =
+                  qualifyPath
+                    (currentScopePath localState)
+                    (NonEmpty.singleton (identToString ident))
+              }
+
+      RegisterDecl
+        (Present qRegMeta)
+        (Guaranteed $ ModifierKeyword Pr ann)
+        (Guaranteed ident)
+        <$> advanceStage localState expr
+        <*> pure Nothing
+        <*> pure ann
+    TypeSubStructure bod name an -> do
+      let localState' = pushIdents name localState
+      TypeSubStructure
+        <$> mapM (advanceStage localState') bod
+        <*> pure name
+        <*> pure an
 
 deriving instance AdvanceStage S (Expression u)
 
@@ -284,6 +355,7 @@ advanceFiddleDecls localState decls = fmap (reverse . fst) $ do
                               <*> pure ann
                   ObjTypeDecl _ ident body ann ->
                     let qualifiedName = qualify (NonEmpty.singleton (identToString ident))
+                        localState'' = modifyCurrentScopePath (pushScope (NonEmpty.singleton $ identToString ident)) localState'
                      in do
                           typeSize <- calculateTypeSize =<< resolveOrFail body
                           let decl =
@@ -295,7 +367,7 @@ advanceFiddleDecls localState decls = fmap (reverse . fst) $ do
                             =<< ObjTypeDecl
                               (qMd decl)
                               ident
-                              <$> mapM (advanceStage localState') body
+                              <$> mapM (advanceStage localState'') body
                               <*> pure ann
                   ObjectDecl _ ident loc typ ann ->
                     let qualifiedName = qualify (NonEmpty.singleton (identToString ident))
@@ -331,7 +403,9 @@ objTypeToExport ls = \case
       <*> expressionToIntM size
   ReferencedObjType {refName = n} -> do
     (full, _ :: ExportedTypeDecl) <- resolveOrFail =<< resolveName n ls
-    return $ ReferencedObjectType (intercalate "." full)
+    case full of
+      (f:fs) -> return $ ReferencedObjectType (f :| fs)
+      _ -> compilationFailure
 
 calculateTypeSize :: ObjTypeBody Expanded F A -> M (N Bytes)
 calculateTypeSize (ObjTypeBody bodyType decls _) =
diff --git a/src/Language/Fiddle/GenericTree.hs b/src/Language/Fiddle/GenericTree.hs
index 1dfafc2..49727f7 100644
--- a/src/Language/Fiddle/GenericTree.hs
+++ b/src/Language/Fiddle/GenericTree.hs
@@ -210,10 +210,6 @@ instance
 instance (GToGenericSyntaxTree r f a) => (GToGenericSyntaxTree (M1 i c r) f a) where
   gToGenericSyntaxTree t (M1 r) = gToGenericSyntaxTree t r
 
-instance (ToJSON t) => ToJSON (When s t) where
-  toJSON (Present t) = toJSON t
-  toJSON _ = toJSON ()
-
 -- deriving instance (ToGenericSyntaxTree (Test stage))
 
 deriving instance (ToGenericSyntaxTree Identifier)
diff --git a/src/Language/Fiddle/Internal/UnitInterface.hs b/src/Language/Fiddle/Internal/UnitInterface.hs
index 2a538eb..42ce810 100644
--- a/src/Language/Fiddle/Internal/UnitInterface.hs
+++ b/src/Language/Fiddle/Internal/UnitInterface.hs
@@ -125,10 +125,10 @@ data ExportedTypeDecl where
 
 data ReferencedObjectType where
   ReferencedObjectType ::
-    {objectTypeReference :: String} -> ReferencedObjectType
+    {objectTypeReference :: NonEmpty String} -> ReferencedObjectType
   ArrayObjectType ::
     { arrayObjectTypeType :: ReferencedObjectType,
-      arryObjecttTypeNumber :: N Unitless
+      arrayObjectTypeNumber :: N Unitless
     } ->
     ReferencedObjectType
   deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
diff --git a/src/Language/Fiddle/Parser.hs b/src/Language/Fiddle/Parser.hs
index 8070c1c..ebbd51b 100644
--- a/src/Language/Fiddle/Parser.hs
+++ b/src/Language/Fiddle/Parser.hs
@@ -207,14 +207,14 @@ objTypeDeclP =
     )
       <|> ( do
               tok_ KWReserved
-              ReservedDecl Vacant Vacant <$> exprInParenP
+              ReservedDecl Witness <$> exprInParenP
           )
       <|> ( do
               bt <- bodyTypeP
               TypeSubStructure <$> defer body (objTypeBodyP bt) <*> optionMaybe ident
           )
       <|> ( do
-              modifier <- optionMaybe modifierP
+              modifier <- Perhaps <$> optionMaybe modifierP
               tok_ KWReg
               RegisterDecl Vacant modifier . Perhaps
                 <$> optionMaybe ident