Implement qualification.

Big change. Implements qualification, which separates the qualification
concerns from the ConsistencyCheck phase.

I'm getting close to implementing a backend.

4 files changed, 535 insertions, 655 deletions

diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
index 3bdae4a..410f3e2 100644
--- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
+++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
@@ -2,636 +2,283 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE IncoherentInstances #-}
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Language.Fiddle.Compiler.ConsistencyCheck
-  ( checkConsistency,
-    consistencyCheckPhase,
-  )
-where
+module Language.Fiddle.Compiler.ConsistencyCheck (consistencyCheckPhase) where
 
-import Control.Monad (forM_, unless, when)
-import Control.Monad.RWS (MonadState (get, put), MonadWriter (tell), gets, modify')
-import Data.Foldable (foldlM)
+import Control.Monad (forM_, when)
+import Control.Monad.RWS (MonadWriter (tell))
+import Control.Monad.Trans.Writer (Writer, execWriter)
+import Data.Foldable (foldlM, toList)
 import Data.Functor.Identity
-import Data.List (intercalate)
-import Data.Maybe (mapMaybe)
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Typeable
 import Data.Word (Word32)
 import GHC.TypeError as TypeError
 import Language.Fiddle.Ast
 import Language.Fiddle.Compiler
-import Language.Fiddle.Internal.Scopes
 import Language.Fiddle.Internal.UnitInterface as UnitInterface
-import Language.Fiddle.Types (Comment (DocComment), Commented (Commented, unCommented), SourceSpan)
-import Prelude hiding (unzip)
+import Language.Fiddle.Types
 import Text.Printf (printf)
+import Prelude hiding (unzip)
 
-import qualified Data.IntMap as IntMap
-import qualified Data.List.NonEmpty as NonEmpty
-import qualified Data.Text as Text
-
-data GlobalState = GlobalState
-  { globalScope :: Scope String (Either SizeBits SizeBytes),
-    _fileDependencies :: [FilePath],
-    unitInterface :: UnitInterface
-  }
-
-newtype LocalState = LocalState (ScopePath String)
-
-type CurrentStage = Qualified
-
-type I = Identity
-
-type Annot = Commented SourceSpan
+type S = Qualified
 
-type SizeBits = Word32
+type S' = Checked
 
-type SizeBytes = Word32
+type F = Identity
 
-consistencyCheckPhase :: CompilationPhase CurrentStage Checked
-consistencyCheckPhase = pureCompilationPhase checkConsistency
+type A = Commented SourceSpan
 
-checkConsistency ::
-  FiddleUnit CurrentStage I Annot ->
-  Compile () (FiddleUnit Checked I Annot)
-checkConsistency =
-  fmap snd
-    . subCompile (GlobalState mempty mempty mempty)
-    . advanceStage (LocalState mempty)
+type M = Compile ()
 
 instance CompilationStage Checked where
   type StageAfter Checked = TypeError (TypeError.Text "No stage after Checked")
-  type StageMonad Checked = Compile GlobalState
-  type StageState Checked = LocalState
+  type StageMonad Checked = M
+  type StageState Checked = ()
   type StageFunctor Checked = Identity
-  type StageAnnotation Checked = Commented SourceSpan
-
-instance CompilationStage CurrentStage where
-  type StageAfter CurrentStage = Checked
-  type StageMonad CurrentStage = Compile GlobalState
-  type StageState CurrentStage = LocalState
-  type StageFunctor CurrentStage = Identity
-  type StageAnnotation CurrentStage = Commented SourceSpan
-
-instance AdvanceStage CurrentStage FiddleUnit where
-  advanceStage localState (FiddleUnit _ decls a) = do
-    decls' <- mapM (advanceStage localState) decls
-    intf <- gets unitInterface
-    return $ FiddleUnit intf decls' a
+  type StageAnnotation Checked = A
 
--- advanceStage localState (FiddleUnit decls _ annot) = do
+instance CompilationStage S where
+  type StageAfter S = S'
+  type StageMonad S = M
+  type StageState S = ()
+  type StageFunctor S = F
+  type StageAnnotation S = A
 
---   decls' <- mapM (advanceStage localState) decls
+consistencyCheckPhase :: CompilationPhase S S'
+consistencyCheckPhase = pureCompilationPhase $ advanceStage ()
 
-deriving instance AdvanceStage CurrentStage Expression
+instance AdvanceStage S ObjTypeBody where
+  advanceStage () objTypeBody = snd <$> advanceObjTypeBody objTypeBody 0
 
-deriving instance AdvanceStage CurrentStage ObjType
+deriving instance AdvanceStage S DeferredRegisterBody
 
-deriving instance AdvanceStage CurrentStage DeferredRegisterBody
+deriving instance AdvanceStage S RegisterBody
 
-deriving instance AdvanceStage CurrentStage RegisterBitsDecl
+deriving instance AdvanceStage S AnonymousBitsType
 
-deriving instance AdvanceStage CurrentStage RegisterBitsTypeRef
+deriving instance AdvanceStage S ImportStatement
 
-deriving instance AdvanceStage CurrentStage AnonymousBitsType
+deriving instance AdvanceStage S BitType
 
-deriving instance AdvanceStage CurrentStage BitType
+deriving instance AdvanceStage S EnumBody
 
-deriving instance AdvanceStage CurrentStage EnumBody
+deriving instance AdvanceStage S EnumConstantDecl
 
-deriving instance AdvanceStage CurrentStage EnumConstantDecl
+deriving instance AdvanceStage S RegisterBitsDecl
 
-deriving instance AdvanceStage CurrentStage PackageBody
+deriving instance AdvanceStage S PackageBody
 
-instance AdvanceStage CurrentStage ImportStatement where
-  modifyState
-    ( ImportStatement
-        { importInterface =
-            ( UnitInterface
-                { rootScope = unitScope,
-                  dependencies = importDependencies
-                }
-              )
-        }
-      )
-    ls = do
-      modify'
-        ( \s@GlobalState
-             { globalScope = globalScope,
-               unitInterface = unitInterface
-             } ->
-              s
-                { globalScope =
-                    unitInterfaceScopeToGlobalScope unitScope <> globalScope,
-                  unitInterface =
-                    unitInterface
-                      { dependencies =
-                          importDependencies ++ dependencies unitInterface
-                      }
-                }
-        )
-      return ls
-      where
-        unitInterfaceScopeToGlobalScope =
-          fmap
-            ( \(_, exportedValue) -> case exportedValue of
-                ExportedBitsType sz -> Left sz
-                ExportedObjType sz -> Right sz
-            )
-
-deriving instance (AdvanceStage CurrentStage t) => AdvanceStage CurrentStage (Directed t)
-
-instance AdvanceStage CurrentStage RegisterBody where
-  advanceStage s body = fst <$> registerBodyToStage3 s body
-
-instance AdvanceStage CurrentStage ObjTypeBody where
-  advanceStage s body = fst <$> objTypeBodyToStage3 s body 0
-
-deriving instance AdvanceStage CurrentStage FiddleDecl
-
-instance AdvanceStage CurrentStage (Directed FiddleDecl) where
-  modifyState (Directed _ t _) s = case t of
-    (BitsDecl _ id typ annotation) -> do
-      typeSize <- getTypeSize typ
-      insertTypeSize annotation s id typeSize
-      return s
-    (PackageDecl _ n _ _) -> do
-      let strs = nameToList n
-      let (LocalState scopePath) = s
-
-      return $
-        LocalState $
-          scopePath {currentScope = strs ++ currentScope scopePath}
-    (UsingDecl _ n _) ->
-      let (LocalState scopePath) = s
-       in return $
-            LocalState $
-              scopePath
-                { usingPaths = nameToList n : usingPaths scopePath
-                }
-    _ -> return s
-
-  customAdvanceStage (Directed directives t a) (LocalState scopePath) = case t of
-    (ObjTypeDecl q ident (Identity body) annot) -> do
-      (body', size) <- objTypeBodyToStage3 (LocalState scopePath) body 0
-
-      let fullName =
-            NonEmpty.prependList
-              (currentScope scopePath)
-              (NonEmpty.singleton (Text.unpack (identifierName ident)))
-
-      ui <- gets unitInterface
-      let ui' = insertIntoUnitInterface fullName ui annot (ExportedObjType size)
-      modify' $ \gs -> gs {unitInterface = ui'}
-
-      return $ Just $ Directed directives (ObjTypeDecl q ident (Identity body') annot) a
-    _ -> return Nothing
-
-objTypeBodyToStage3 ::
-  LocalState ->
-  ObjTypeBody CurrentStage I Annot ->
-  Word32 ->
-  Compile GlobalState (ObjTypeBody Checked I Annot, Word32)
-objTypeBodyToStage3 st (ObjTypeBody bodyType decls a) startOff = do
-  let isUnion = case bodyType of
-        Union {} -> True
-        _ -> False
-  (cur, returned) <-
-    foldlM
-      ( \(cursor, returned) decl ->
-          case undirected decl of
-            RegisterDecl mMod mIdent expr mBody a -> do
-              (s3RegisterBody, mCalculatedSize) <-
-                fUnzip <$> mapM (registerBodyToStage3 st) mBody
-
-              nExpr <- advanceStage st expr
-
-              let s3 =
-                    mapDirected
-                      ( const $
-                          RegisterDecl
-                            mMod
-                            mIdent
-                            nExpr
-                            s3RegisterBody
-                            a
-                      )
-                      decl
-
-              declaredSizeBits <- fromIntegral <$> exprToSize expr
-
-              when ((declaredSizeBits `mod` 8) /= 0) $
-                tell
-                  [ Diagnostic
-                      Error
-                      "Register size is not a multiple of 8. Please pad register size to align with 8. "
-                      (unCommented a)
-                  ]
-
-              forM_ mCalculatedSize $ \(fromIntegral -> calculatedSize) ->
-                unless (calculatedSize == declaredSizeBits) $
-                  let helpful =
-                        if calculatedSize < declaredSizeBits
-                          then
-                            printf
-                              "\nPerhaps you should add 'reserved(%d)' to the end of your register declaration?"
-                              (declaredSizeBits - calculatedSize)
-                          else ""
-                   in tell
-                        [ Diagnostic
-                            Error
-                            ( printf
-                                "Calculated size %d does not match declared size %d.%s"
-                                calculatedSize
-                                declaredSizeBits
-                                helpful
-                            )
-                            (unCommented a)
-                        ]
-
-              if isUnion
-                then
-                  checkUnion cursor (declaredSizeBits `div` 8) (s3 : returned) a
-                else
-                  return (cursor + declaredSizeBits `div` 8, s3 : returned)
-            TypeSubStructure (Identity subBody) maybeIdent annot -> do
-              (newBody, size) <-
-                objTypeBodyToStage3
-                  st
-                  subBody
-                  ( if isUnion then startOff else cursor
-                  )
-              let s3 = mapDirected (const $ TypeSubStructure (Identity newBody) maybeIdent annot) decl
-
-              checkTypesSubStructure subBody maybeIdent annot
-              if isUnion
-                then
-                  checkUnion cursor size (s3 : returned) a
-                else
-                  return (cursor + size, s3 : returned)
-            ReservedDecl expr annot -> do
-              size' <- fromIntegral <$> exprToSize expr
-              when ((size' `mod` 8) /= 0) $
-                tell
-                  [ Diagnostic
-                      Error
-                      "Can only reserve a multiple of 8 bits in this context."
-                      (unCommented a)
-                  ]
-
-              expr' <- advanceStage st expr
-              let size = size' `div` 8
-              let s3 = mapDirected (const $ ReservedDecl expr' annot) decl
-              if isUnion
-                then
-                  checkUnion cursor size (s3 : returned) a
-                else
-                  return (cursor + size, s3 : returned)
-            AssertPosStatement _ expr a -> do
-              declaredPos <- fromIntegral <$> exprToSize expr
-
-              let expectedPos = if isUnion then startOff else cursor + startOff
-
-              when (expectedPos /= declaredPos) $ do
-                tell
-                  [ Diagnostic
-                      Error
-                      ( printf
-                          "Position assertion failed. Asserted 0x%x, calculated 0x%x"
-                          declaredPos
-                          expectedPos
-                      )
-                      (unCommented a)
-                  ]
-              return (cursor, returned)
-      )
-      (0, [])
-      decls
+deriving instance AdvanceStage S FiddleDecl
 
-  return (ObjTypeBody bodyType (reverse returned) a, cur)
-  where
-    checkTypesSubStructure
-      (ObjTypeBody bodyType decls _)
-      maybeIdent
-      annot =
-        let emitWarning s = tell [Diagnostic Warning s (unCommented annot)]
-         in case () of
-              ()
-                | [_] <- decls,
-                  (Union {}) <- bodyType ->
-                    emitWarning "Union with a single field. Should this be a struct?"
-              ()
-                | [_] <- decls,
-                  (Struct {}) <- bodyType,
-                  Nothing <- maybeIdent ->
-                    emitWarning "Anonymous sub-struct with single field is superfluous."
-              ()
-                | [] <- decls ->
-                    emitWarning
-                      ( printf
-                          "Empty sub-%s is superfluous."
-                          ( case bodyType of
-                              Union {} -> "union"
-                              Struct {} -> "struct"
-                          )
-                      )
-              _ -> return ()
-    fUnzip xs = (fst <$> xs, snd <$> xs)
-
-registerBodyToStage3 ::
-  LocalState ->
-  RegisterBody CurrentStage I Annot ->
-  Compile GlobalState (RegisterBody Checked I Annot, Word32)
-registerBodyToStage3
-  st
-  (RegisterBody bodyType (Identity deferredRegisterBody) a') = do
-    let isUnion = case bodyType of
-          Union {} -> True
-          _ -> False
-
-    case deferredRegisterBody of
-      DeferredRegisterBody decls a -> do
-        (cur, returned) <-
-          foldlM
-            ( \(cursor, returned) decl ->
-                case undirected decl of
-                  ReservedBits expr a -> do
-                    size <- fromIntegral <$> exprToSize expr
-                    expr' <- advanceStage st expr
-                    let s3 =
-                          mapDirected
-                            (const $ ReservedBits expr' a)
-                            decl
-                    if isUnion
-                      then checkUnion cursor size (s3 : returned) a
-                      else
-                        return (cursor + size, s3 : returned)
-                  BitsSubStructure registerBody maybeIdent annot -> do
-                    checkBitsSubStructure registerBody maybeIdent annot
-
-                    (newBody, subsize) <- registerBodyToStage3 st registerBody
-                    let s3 =
-                          mapDirected
-                            (const $ BitsSubStructure newBody maybeIdent annot)
-                            decl
-
-                    if isUnion
-                      then checkUnion cursor subsize (s3 : returned) a
-                      else
-                        return (cursor + subsize, s3 : returned)
-                  DefinedBits modifier identifier typeref a -> do
-                    (s3TypeRef, size) <- registerBitsTypeRefToStage3 st typeref
-                    let s3 =
-                          mapDirected
-                            (const $ DefinedBits modifier identifier s3TypeRef a)
-                            decl
-
-                    if isUnion
-                      then checkUnion cursor size (s3 : returned) a
-                      else
-                        return (cursor + size, s3 : returned)
-            )
-            (0, [])
-            decls
-
-        return
-          ( RegisterBody
-              bodyType
-              (Identity (DeferredRegisterBody (reverse returned) a))
-              a',
-            cur
-          )
+instance AdvanceStage S FiddleUnit where
+  advanceStage () fu@(FiddleUnit _ decls a) =
+    FiddleUnit (getUnitInterface fu) <$> mapM (advanceStage ()) decls <*> pure a
     where
-      checkBitsSubStructure
-        (RegisterBody bodyType (Identity (DeferredRegisterBody decls _)) _)
-        maybeIdent
-        annot =
-          let emitWarning s = tell [Diagnostic Warning s (unCommented annot)]
-           in case () of
-                ()
-                  | [_] <- decls,
-                    (Union {}) <- bodyType ->
-                      emitWarning "Union with a single field. Should this be a struct?"
-                ()
-                  | [_] <- decls,
-                    (Struct {}) <- bodyType,
-                    Nothing <- maybeIdent ->
-                      emitWarning "Anonymous sub-struct with single field is superfluous."
-                ()
-                  | [] <- decls ->
-                      emitWarning
-                        ( printf
-                            "Empty sub-%s is superfluous."
-                            ( case bodyType of
-                                Union {} -> "union"
-                                Struct {} -> "struct"
-                            )
-                        )
-                _ -> return ()
-
-registerBitsTypeRefToStage3 ::
-  LocalState ->
-  RegisterBitsTypeRef CurrentStage I Annot ->
-  Compile GlobalState (RegisterBitsTypeRef Checked I Annot, Word32)
-registerBitsTypeRefToStage3 localState = \case
-  RegisterBitsArray ref expr a -> do
-    (ref', size) <- registerBitsTypeRefToStage3 localState ref
-    multiplier <- exprToSize expr
-    expr' <- advanceStage localState expr
-    return
-      ( RegisterBitsArray ref' expr' a,
-        size * fromIntegral multiplier
-      )
-  RegisterBitsReference q name a ->
-    (RegisterBitsReference q name a,) <$> lookupTypeSize localState name
-  RegisterBitsJustBits expr a -> do
-    expr' <- advanceStage localState expr
-    (RegisterBitsJustBits expr' a,)
-      . fromIntegral
-      <$> exprToSize expr
-
-checkUnion :: Word32 -> Word32 -> b -> Commented SourceSpan -> Compile s (Word32, b)
-checkUnion cursor subsize ret a = do
-  when (cursor /= 0 && subsize /= cursor) $ do
-    tell
-      [ Diagnostic
-          Warning
-          ( printf
-              "Jagged union found. Found size %d, expected %d.\n \
-              \ Please wrap smaller fields in a struct with padding so all \
-              \ fields are the same size?"
-              subsize
-              cursor
-          )
-          (unCommented a)
-      ]
-  return (max cursor subsize, ret)
-
-exprToSize ::
-  (NumberType stage ~ Integer) =>
-  Expression stage I Annot ->
-  Compile s Integer
-exprToSize (LitNum num _) = return num
-exprToSize e = do
-  tell [Diagnostic Error "Variables not allowed" (unCommented $ annot e)]
-  compilationFailure
-
-lookupTypeSize :: LocalState -> Name I Annot -> Compile GlobalState SizeBits
-lookupTypeSize (LocalState scopePath) (Name idents a) = do
-  -- Convert the list of identifiers to a string path
-  let path = fmap (\(Identifier s _) -> Text.unpack s) idents
-
-  -- Get the current scope and perform the lookup
-  results <- gets $ lookupScopeWithPath scopePath path . globalScope
-
-  case results of
-    -- Successfully resolved to a unique size
-    [(_, Left sz)] -> return sz
-    -- Multiple ambiguous results found
-    matches@(_ : _ : _) -> do
-      -- Generate a list of ambiguous paths for error reporting
-      let ambiguousPaths =
-            map
-              ( \(resolvedPath, _) ->
-                  intercalate "." (NonEmpty.toList resolvedPath)
-              )
-              matches
-      tell
-        [ Diagnostic
-            Error
-            ( printf
-                "Ambiguous occurrence of '%s'. Multiple matches found:\n%s"
-                (intercalate "." $ NonEmpty.toList path)
-                (unlines ambiguousPaths) -- List all ambiguous paths
-            )
-            (unCommented a)
-        ]
-      compilationFailure
-
-    -- No matches found
-    [] -> do
-      tell
-        [ Diagnostic
-            Error
-            ( printf
-                "Cannot resolve '%s'. No matching symbols found."
-                (intercalate "." $ NonEmpty.toList path)
-            )
-            (unCommented a)
-        ]
-      compilationFailure
-    _ -> compilationFailure
-
-getTypeSize :: BitType CurrentStage I Annot -> Compile s SizeBits
-getTypeSize (RawBits expr _) = fromIntegral <$> exprToSize expr
-getTypeSize (EnumBitType expr (Identity (EnumBody constants _)) ann) = do
-  declaredSize <- fromIntegral <$> exprToSize expr
-
-  -- If the declared size is less than or equal to 4, we'll enforce that the
-  -- enum is packed. This is to make sure the user has covered all bases.
-  when (declaredSize <= 4) $ do
-    imap <-
+      getUnitInterface = execWriter . walk_ doWalk
+
+      doWalk :: forall t'. (Walk t', Typeable t') => t' F A -> Writer UnitInterface ()
+      doWalk t =
+        case () of
+          ()
+            | (Just (PackageDecl {packageQualificationMetadata = (Identity d)})) <-
+                castTS t ->
+                tell (UnitInterface.singleton d)
+            | (Just (LocationDecl {locationQualificationMetadata = (Identity d)})) <-
+                castTS t ->
+                tell (UnitInterface.singleton d)
+            | (Just (BitsDecl {bitsQualificationMetadata = (Identity d)})) <-
+                castTS t ->
+                tell (UnitInterface.singleton d)
+            | (Just (ObjTypeDecl {objTypeQualificationMetadata = (Identity d)})) <-
+                castTS t ->
+                tell (UnitInterface.singleton d)
+            | (Just (ObjectDecl {objectQualificationMetadata = (Identity d)})) <-
+                castTS t ->
+                tell (UnitInterface.singleton d)
+            | (Just (ImportStatement {importInterface = ii})) <-
+                castTS t ->
+                tell (UnitInterface mempty (dependencies ii))
+          _ -> return ()
+
+      castTS ::
+        (Typeable t', Typeable t, Typeable f, Typeable a) =>
+        t' f a ->
+        Maybe (t S f a)
+      castTS = cast
+
+deriving instance AdvanceStage S Expression
+
+deriving instance AdvanceStage S RegisterBitsTypeRef
+
+deriving instance AdvanceStage S ObjType
+
+deriving instance (AdvanceStage S t) => AdvanceStage S (Directed t)
+
+advanceObjTypeBody :: ObjTypeBody S F A -> Word32 -> M (Word32, ObjTypeBody S' F A)
+advanceObjTypeBody (ObjTypeBody us decls a) startOffset = do
+  (decls', _) <- advanceDecls
+
+  calcSize <- case us of
+    Union {} -> do
+      checkJagged decls'
+      return $ maximum (map fst decls')
+    Struct {} -> return $ sum (map fst decls')
+
+  return (calcSize, ObjTypeBody us (reverse $ map snd decls') a)
+  where
+    advanceDecls :: M ([(Word32, Directed ObjTypeDecl S' F A)], Word32)
+    advanceDecls = do
       foldlM
-        ( \imap (undirected -> enumConst) -> do
-            number <- case enumConst of
-              EnumConstantDecl _ expr _ -> exprToSize expr
-              EnumConstantReserved expr _ -> exprToSize expr
-
-            when (number >= 2 ^ declaredSize) $
-              tell
-                [ Diagnostic
-                    Error
-                    ( printf
-                        "Enum constant too large. Max allowed %d\n"
-                        ((2 :: Int) ^ declaredSize)
-                    )
-                    (unCommented (annot enumConst))
-                ]
-
-            return $ IntMap.insert (fromIntegral number) True imap
+        ( \(ret, offset) d ->
+            let advanceOffset = case us of
+                  Union {} -> const
+                  Struct {} -> (+)
+                doReturn x size = return ((size, mapDirected (const x) d) : ret, advanceOffset offset size)
+             in case undirected d of
+                  e@AssertPosStatement {assertExpr = expr} -> do
+                    assertedPos <- expressionToIntM expr
+                    checkPositionAssertion (annot e) assertedPos offset
+                    return (ret, offset)
+                  (RegisterDecl mod ident size Nothing a) -> do
+                    (sizeExpr, reifiedSize) <- advanceAndGetSize size
+                    doReturn (RegisterDecl mod ident sizeExpr Nothing a)
+                      =<< checkBitsSizeMod8 a reifiedSize
+                  (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)
+                      =<< checkBitsSizeMod8 a reifiedSize
+                  (ReservedDecl size a) -> do
+                    (sizeExpr, reifiedSize) <- advanceAndGetSize size
+                    doReturn (ReservedDecl sizeExpr a) reifiedSize
+                  (TypeSubStructure (Identity body) name a) -> do
+                    (size, body') <- advanceObjTypeBody body offset
+                    doReturn (TypeSubStructure (Identity body') name a) size
         )
-        IntMap.empty
-        constants
-    let missing =
-          filter (not . (`IntMap.member` imap)) [0 .. 2 ^ declaredSize - 1]
-    unless (null missing) $
-      tell
-        [ Diagnostic
-            Warning
-            ( printf
-                "Missing enum constants %s. Small enums should be fully \
-                \ populated. Use 'reserved' if needed."
-                (intercalate ", " (map show missing))
-            )
-            (unCommented ann)
-        ]
-
-  return declaredSize
-
-diagnosticError :: String -> Annot -> Compile a ()
-diagnosticError str a = tell [Diagnostic Error str (unCommented a)]
-
-insertIntoUnitInterface ::
-  NonEmpty.NonEmpty String ->
-  UnitInterface ->
-  Commented SourceSpan ->
-  ExportedValue ->
-  UnitInterface
-insertIntoUnitInterface path ui (Commented comments srcspan) val =
-  let docComments =
-        mconcat
-          ( mapMaybe
-              ( \com -> do
-                  (DocComment txt) <- Just com
-                  return txt
-              )
-              comments
+        (([], startOffset) :: ([(Word32, Directed ObjTypeDecl S' F A)], Word32))
+        decls
+
+    advanceAndGetSize e = (,) <$> advanceStage () e <*> expressionToIntM e
+
+pattern RegisterBodyPattern :: BodyType F A -> [Directed RegisterBitsDecl s F A] -> A -> A -> RegisterBody s F A
+pattern RegisterBodyPattern u decls a b = RegisterBody u (Identity (DeferredRegisterBody decls b)) a
+
+-- registerBodyPattern u decls a b = RegisterBody u (Identity (DeferredRegisterBody decls a)) a
+
+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)
+        )
+        decls
+    calcSize <- case us of
+      Union {} -> do
+        checkJagged (toList decls')
+        return $ maximum (map fst (toList decls'))
+      Struct {} -> do
+        return $ sum (map fst (toList decls'))
+
+    return (calcSize, RegisterBodyPattern us (map snd $ toList decls') a b)
+
+-- Handle the case where there's no decls.
+advanceRegisterBody (RegisterBodyPattern u _ a b) =
+  return (0, RegisterBodyPattern u [] a b)
+advanceRegisterBody RegisterBody {} = error "GHC not smart enuf"
+
+checkJagged :: (Annotated t) => [(Word32, t f A)] -> Compile s ()
+checkJagged decls = do
+  let expectedSize = maximum (fmap fst decls)
+  forM_ decls $ \(sz, annot -> a) ->
+    when (sz /= expectedSize) $
+      emitDiagnosticWarning
+        ( printf
+            "[JaggedUnion] - All elements of a union should be the same size. \
+            \ this element is size %d, expected size %d. Maybe bundle this with \
+            \ reserved(%d)?"
+            sz
+            expectedSize
+            (expectedSize - sz)
+        )
+        a
+
+advanceDecl :: RegisterBitsDecl S F A -> M (Word32, RegisterBitsDecl S' F A)
+advanceDecl = \case
+  ReservedBits expr an -> do
+    sz <- expressionToIntM expr
+    (sz,)
+      <$> ( ReservedBits
+              <$> advanceStage () expr
+              <*> pure an
           )
-   in ui
-        { rootScope =
-            insertScope
-              path
-              ( Metadata srcspan docComments [],
-                val
-              )
-              (rootScope ui)
-        }
-
-insertTypeSize ::
-  Annot ->
-  LocalState ->
-  Identifier f Annot ->
-  SizeBits ->
-  Compile GlobalState ()
-insertTypeSize annot (LocalState scopePath) (Identifier s idannot) size = do
-  modifyM $
-    \state@GlobalState
-       { globalScope = globalScope,
-         unitInterface = unitInterface
-       } ->
-        let fullName =
-              NonEmpty.prependList
-                (currentScope scopePath)
-                (NonEmpty.singleton (Text.unpack s))
-         in case upsertScope fullName (Left size) globalScope of
-              (Just _, _) -> do
-                diagnosticError (printf "Duplicate type %s" s) idannot
-
-                compilationFailure
-              (Nothing, n) ->
-                let unitInterface' =
-                      insertIntoUnitInterface
-                        fullName
-                        unitInterface
-                        annot
-                        (ExportedBitsType size)
-                 in return $
-                      state
-                        { globalScope = n,
-                          unitInterface = unitInterface'
-                        }
-  where
-    modifyM fn = do
-      s <- get
-      put =<< fn s
+  DefinedBits mod ident typ annot -> do
+    size <- bitsTypeSize typ
+    (size,)
+      <$> (DefinedBits mod ident <$> advanceStage () typ <*> pure annot)
+  BitsSubStructure subBody subName ann -> do
+    (sz, body') <- advanceRegisterBody subBody
+    return (sz, BitsSubStructure body' subName ann)
+
+bitsTypeSize :: RegisterBitsTypeRef S F A -> M Word32
+bitsTypeSize (RegisterBitsArray tr nExpr _) = do
+  sz <- bitsTypeSize tr
+  n <- expressionToIntM nExpr
+  return (sz * n)
+bitsTypeSize
+  RegisterBitsReference
+    { bitsRefQualificationMetadata =
+        Identity (ExportedBitsDecl {exportedBitsDeclSizeBits = sz})
+    } = return sz
+bitsTypeSize (RegisterBitsJustBits expr _) =
+  expressionToIntM expr
+
+checkSizeMismatch :: A -> Word32 -> Word32 -> Compile s ()
+checkSizeMismatch _ a b | a == b = return ()
+checkSizeMismatch pos declaredSize calculatedSize =
+  emitDiagnosticError
+    ( printf
+        "Size assertion failed. Declared size %d, calculated %d"
+        declaredSize
+        calculatedSize
+    )
+    pos
+
+checkPositionAssertion :: A -> Word32 -> Word32 -> Compile s ()
+checkPositionAssertion _ a b | a == b = return ()
+checkPositionAssertion pos declaredPosition calculatedPostion =
+  emitDiagnosticError
+    ( printf
+        "Position assertion failed. Asserted 0x%x, calculated 0x%x"
+        declaredPosition
+        calculatedPostion
+    )
+    pos
+
+expressionToIntM ::
+  (Integral i, Integral (NumberType stage)) =>
+  Expression stage f A ->
+  Compile s i
+expressionToIntM expr =
+  resolveOrFail $
+    either
+      ( \reason -> Left [Diagnostic Error reason (unCommented $ annot expr)]
+      )
+      return
+      (expressionToInt expr)
+
+checkBitsSizeMod8 :: A -> Word32 -> M Word32
+checkBitsSizeMod8 _ w | w `mod` 8 == 0 = return (w `div` 8)
+checkBitsSizeMod8 a w = do
+  emitDiagnosticWarning
+    (printf "Register size %d is not a multiple of 8. Please add padding to this register." w)
+    a
+  return ((w `div` 8) + 1)
diff --git a/src/Language/Fiddle/Compiler/Expansion.hs b/src/Language/Fiddle/Compiler/Expansion.hs
index 1c4df45..19b7323 100644
--- a/src/Language/Fiddle/Compiler/Expansion.hs
+++ b/src/Language/Fiddle/Compiler/Expansion.hs
@@ -120,8 +120,8 @@ instance AdvanceStage CurrentStage RegisterBitsTypeRef where
         <$> advanceStage path typeref
         <*> advanceStage path expr
         <*> pure annot
-    RegisterBitsReference () name annot ->
-      return $ RegisterBitsReference () name annot
+    RegisterBitsReference q name annot ->
+      return $ RegisterBitsReference q name annot
     RegisterBitsJustBits expr annot ->
       RegisterBitsJustBits
         <$> advanceStage path expr
@@ -130,16 +130,16 @@ instance AdvanceStage CurrentStage RegisterBitsTypeRef where
       ident <-
         internAnonymousBitsType path
           =<< advanceStage path anonType
-      return $ RegisterBitsReference () (identToName ident) annot
+      return $ RegisterBitsReference (pure ()) (identToName ident) annot
 
 instance AdvanceStage CurrentStage ObjType where
   advanceStage path = \case
     (AnonymousObjType _ (Identity body) annot) -> do
       body' <- advanceStage path body
       identifier <- internObjType path body'
-      return (ReferencedObjType () (identToName identifier) annot)
-    (ReferencedObjType () name annot) ->
-      return $ ReferencedObjType () name annot
+      return (ReferencedObjType (pure ()) (identToName identifier) annot)
+    (ReferencedObjType q name annot) ->
+      return $ ReferencedObjType q name annot
     (ArrayObjType objType expr a) ->
       ArrayObjType
         <$> advanceStage path objType
@@ -197,13 +197,13 @@ reconfigureFiddleDecls p decls = do
   where
     resolveAnonymousObjType (Linkage linkage, objTypeBody) =
       ObjTypeDecl
-        ()
+        (pure ())
         (Identifier linkage (annot objTypeBody))
         (pure objTypeBody)
         (annot objTypeBody)
 
     resolveAnonymousBitsType (Linkage linkage, AnonymousEnumBody expr body a) =
-      BitsDecl () (Identifier linkage a) (EnumBitType expr body a) a
+      BitsDecl (pure ()) (Identifier linkage a) (EnumBitType expr body a) a
 
 identToName :: Identifier I a -> Name I a
 identToName ident = Name (NonEmpty.singleton ident) (annot ident)
diff --git a/src/Language/Fiddle/Compiler/ImportResolution.hs b/src/Language/Fiddle/Compiler/ImportResolution.hs
index 4d4bd32..b475801 100644
--- a/src/Language/Fiddle/Compiler/ImportResolution.hs
+++ b/src/Language/Fiddle/Compiler/ImportResolution.hs
@@ -124,9 +124,6 @@ deriving instance (AdvanceStage CurrentStage t) => AdvanceStage CurrentStage (Di
 
 deriving instance AdvanceStage CurrentStage FiddleDecl
 
-diagnosticError :: String -> Annot -> Compile a ()
-diagnosticError str a = tell [Diagnostic Error str (unCommented a)]
-
 instance AdvanceStage CurrentStage ImportStatement where
   advanceStage s (ImportStatement path list _ a) = do
     let what = Map.lookup path (importMap s)
@@ -134,7 +131,7 @@ instance AdvanceStage CurrentStage ImportStatement where
 
     v <- case what of
       Nothing -> do
-        diagnosticError "Failed to lookup imports (This is a bug)" a
+        emitDiagnosticError "Failed to lookup imports (This is a bug)" a
         return empty
       Just (diags, val) -> do
         tell diags
diff --git a/src/Language/Fiddle/Compiler/Qualification.hs b/src/Language/Fiddle/Compiler/Qualification.hs
index eddb3cb..7eea141 100644
--- a/src/Language/Fiddle/Compiler/Qualification.hs
+++ b/src/Language/Fiddle/Compiler/Qualification.hs
@@ -10,97 +10,333 @@
 -- removed, as they become unnecessary once references are fully qualified.
 module Language.Fiddle.Compiler.Qualification (qualificationPhase) where
 
-import Control.Monad.Identity
+import Control.Monad.RWS (MonadWriter (tell))
+import Control.Monad.State
 import Data.Foldable (foldlM)
+import Data.List (intercalate)
+import Data.List.NonEmpty (NonEmpty (..), toList)
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Maybe (mapMaybe)
 import Data.Word
 import Language.Fiddle.Ast
 import Language.Fiddle.Compiler
 import Language.Fiddle.Compiler.ConsistencyCheck ()
 import Language.Fiddle.Internal.Scopes
-import Language.Fiddle.Internal.UnitInterface
+import Language.Fiddle.Internal.UnitInterface as UnitInterface
 import Language.Fiddle.Types
+import Text.Printf (printf)
 
-type CurrentStage = Expanded
+type S = Expanded
 
-data GlobalState = GlobalState
-  { _globalScope :: Scope String (Either SizeBits SizeBytes),
-    _fileDependencies :: [FilePath],
-    _unitInterface :: UnitInterface
+newtype GlobalState = GlobalState
+  { unitInterface :: UnitInterface
   }
 
-newtype LocalState = LocalState (ScopePath String)
-
-type I = Identity
+data LocalState = LocalState
+  { currentScopePath :: ScopePath String,
+    ephemeralScope :: Scope String (Metadata, ExportedDecl)
+  }
 
-type Annot = Commented SourceSpan
+type F = Either [Diagnostic]
 
-type SizeBits = Word32
+type A = Commented SourceSpan
 
-type SizeBytes = Word32
+type M = Compile GlobalState
 
 instance CompilationStage Expanded where
   type StageAfter Expanded = Qualified
-  type StageMonad Expanded = Compile GlobalState
+  type StageMonad Expanded = M
   type StageState Expanded = LocalState
-  type StageFunctor Expanded = I
-  type StageAnnotation Expanded = Annot
+  type StageFunctor Expanded = F
+  type StageAnnotation Expanded = A
 
 qualificationPhase :: CompilationPhase Expanded Qualified
 qualificationPhase =
-  pureCompilationPhase $
-    fmap snd
-      . subCompile (GlobalState mempty mempty mempty)
-      . advanceStage (LocalState mempty)
+  pureCompilationPhase $ \t -> do
+    raw <-
+      fmap snd $
+        subCompile (GlobalState mempty) $
+          advanceStage
+            (LocalState mempty mempty)
+            (soakA t)
+
+    squeezeDiagnostics raw
 
-deriving instance AdvanceStage CurrentStage ObjTypeBody
+deriving instance AdvanceStage S ObjTypeBody
 
-deriving instance AdvanceStage CurrentStage DeferredRegisterBody
+deriving instance AdvanceStage S DeferredRegisterBody
 
-deriving instance AdvanceStage CurrentStage RegisterBody
+deriving instance AdvanceStage S RegisterBody
 
-deriving instance AdvanceStage CurrentStage AnonymousBitsType
+deriving instance AdvanceStage S AnonymousBitsType
 
-deriving instance AdvanceStage CurrentStage ImportStatement
+deriving instance AdvanceStage S ImportStatement
 
-deriving instance AdvanceStage CurrentStage BitType
+deriving instance AdvanceStage S BitType
 
-deriving instance AdvanceStage CurrentStage EnumBody
+deriving instance AdvanceStage S EnumBody
 
-deriving instance AdvanceStage CurrentStage EnumConstantDecl
+deriving instance AdvanceStage S EnumConstantDecl
 
-deriving instance AdvanceStage CurrentStage RegisterBitsDecl
+deriving instance AdvanceStage S RegisterBitsDecl
 
-deriving instance AdvanceStage CurrentStage ObjTypeDecl
+deriving instance AdvanceStage S ObjTypeDecl
 
-deriving instance AdvanceStage CurrentStage Expression
+deriving instance AdvanceStage S Expression
 
-instance AdvanceStage CurrentStage RegisterBitsTypeRef where
-  advanceStage = undefined
+instance AdvanceStage S RegisterBitsTypeRef where
+  advanceStage localState = \case
+    RegisterBitsArray a b c ->
+      RegisterBitsArray
+        <$> advanceStage localState a
+        <*> advanceStage localState b
+        <*> pure c
+    RegisterBitsJustBits a b ->
+      RegisterBitsJustBits
+        <$> advanceStage localState a
+        <*> pure b
+    RegisterBitsReference _ name a -> do
+      v <- fmap snd <$> resolveName name localState
+      return $ RegisterBitsReference v name a
 
-instance AdvanceStage CurrentStage ObjType where
-  advanceStage = undefined
+instance AdvanceStage S ObjType where
+  advanceStage localState = \case
+    ArrayObjType a b c ->
+      ArrayObjType
+        <$> advanceStage localState a
+        <*> advanceStage localState b
+        <*> pure c
+    ReferencedObjType _ name a -> do
+      v <- fmap snd <$> resolveName name localState
+      return $ ReferencedObjType v name a
 
-deriving instance (AdvanceStage CurrentStage t) => AdvanceStage CurrentStage (Directed t)
+deriving instance (AdvanceStage S t) => AdvanceStage S (Directed t)
 
-instance AdvanceStage CurrentStage PackageBody where
+instance AdvanceStage S PackageBody where
   advanceStage localState (PackageBody decls a) =
     PackageBody <$> advanceFiddleDecls localState decls <*> pure a
 
-instance AdvanceStage CurrentStage FiddleUnit where
+instance AdvanceStage S FiddleUnit where
   advanceStage localState (FiddleUnit () decls a) =
     FiddleUnit () <$> advanceFiddleDecls localState decls <*> pure a
 
+modifyEphemeralScope ::
+  ( Scope String (Metadata, ExportedDecl) -> Scope String (Metadata, ExportedDecl)
+  ) ->
+  LocalState ->
+  LocalState
+modifyEphemeralScope fn ls@LocalState {ephemeralScope = es} =
+  ls {ephemeralScope = fn es}
+
+modifyCurrentScopePath ::
+  (ScopePath String -> ScopePath String) ->
+  LocalState ->
+  LocalState
+modifyCurrentScopePath fn ls@LocalState {currentScopePath = cs} =
+  ls {currentScopePath = fn cs}
+
+resolveIdent :: (ExportableDecl d, Functor f) => Identifier f A -> LocalState -> M (F ([String], d))
+resolveIdent i = resolveSymbol (annot i) [identToString i]
+
+resolveName :: (ExportableDecl d, Functor f) => Name f A -> LocalState -> M (F ([String], d))
+resolveName n = resolveSymbol (annot n) (toList $ nameToList n)
+
+resolveSymbol :: (ExportableDecl d) => A -> [String] -> LocalState -> M (F ([String], d))
+resolveSymbol a (p : ps) (LocalState {ephemeralScope = ephemeralScope, currentScopePath = currentPath}) = do
+  GlobalState {unitInterface = UnitInterface {rootScope = rootScope}} <- get
+
+  let matches =
+        concatMap
+          ( mapMaybe (\(p, (m, e)) -> (p,) . (m,) <$> fromExportedDecl e)
+              . lookupScopeWithPath currentPath (p :| ps)
+          )
+          [rootScope, ephemeralScope]
+
+  return $
+    case matches of
+      [(p, (_, e))] -> Right (toList p, e)
+      [] ->
+        Left
+          [ Diagnostic
+              Error
+              ( printf "Could not resolve symbol %s" (intercalate "." (p : ps))
+              )
+              (unCommented a)
+          ]
+      (_ : _ : _) -> do
+        Left
+          [ Diagnostic
+              Error
+              ( printf
+                  "Ambiguous occurance of %s"
+                  (intercalate "." (p : ps))
+              )
+              (unCommented a)
+          ]
+resolveSymbol a _ _ =
+  return $ Left [Diagnostic Error "Empty path provided (this is a bug)" (unCommented a)]
+
 advanceFiddleDecls ::
   LocalState ->
-  [TreeType (Directed FiddleDecl) CurrentStage] ->
-  (StageMonad CurrentStage)
-    [TreeType (Directed FiddleDecl) Qualified]
-advanceFiddleDecls (LocalState scopePath) decls = fmap (reverse . fst) $ do
+  [Directed FiddleDecl S F A] ->
+  M [Directed FiddleDecl Qualified F A]
+advanceFiddleDecls localState decls = fmap (reverse . fst) $ do
   foldlM
-    ( \(declsRet, scopePath') -> \case
-        Directed {directedSubtree = UsingDecl {usingName = name}} ->
-          return (declsRet, addUsingPath (nameToList name) scopePath')
-        _ -> undefined
+    ( \(declsRet, localState' :: LocalState) unsqeezedd -> do
+        d <- case squeeze unsqeezedd of
+          Left diags -> tell diags >> compilationFailure
+          Right x -> return x
+        case unsqeezedd of
+          (Directed directives t dann) ->
+            let doReturn ::
+                  FiddleDecl Qualified F A ->
+                  M ([Directed FiddleDecl Qualified F A], LocalState)
+                doReturn v = return (Directed directives v dann : declsRet, localState')
+                doReturnWith s v = return (Directed directives v dann : declsRet, s)
+                qualify = qualifyPath (currentScopePath localState')
+                metadata = directiveToMetadata d
+             in case t of
+                  UsingDecl {usingName = name} ->
+                    return (declsRet, modifyCurrentScopePath (addUsingPath (nameToList name)) localState')
+                  OptionDecl key value ann -> doReturn $ OptionDecl key value ann
+                  ImportDecl st@(ImportStatement {importInterface = interface}) a ->
+                    let localState'' = modifyEphemeralScope (<> rootScope interface) localState'
+                     in doReturnWith localState''
+                          =<< ImportDecl
+                            <$> advanceStage localState'' st
+                            <*> pure a
+                  PackageDecl _ name body ann ->
+                    let qualifiedName = qualify (nameToList name)
+                        localState'' = modifyCurrentScopePath (pushScope (nameToList name)) localState'
+                        decl = ExportedPackageDecl (metadata qualifiedName)
+                     in do
+                          insertDecl decl
+                          doReturn
+                            =<< PackageDecl
+                              (pure decl)
+                              name
+                              <$> mapM (advanceStage localState'') body
+                              <*> pure ann
+                  LocationDecl _ ident expr ann ->
+                    let qualifiedName = qualify (NonEmpty.singleton (identToString ident))
+                     in do
+                          exprValue <- expressionToIntM expr
+                          let decl =
+                                ExportedLocationDecl
+                                  (metadata qualifiedName)
+                                  exprValue
+                          insertDecl decl
+                          doReturn
+                            =<< LocationDecl
+                              (pure decl)
+                              ident
+                              <$> advanceStage localState' expr
+                              <*> pure ann
+                  BitsDecl _ ident typ ann ->
+                    let qualifiedName = qualify (NonEmpty.singleton (identToString ident))
+                     in do
+                          sizeBits <- getBitTypeDeclaredSize typ
+                          let decl =
+                                ExportedBitsDecl
+                                  (metadata qualifiedName)
+                                  sizeBits
+                          insertDecl decl
+                          doReturn
+                            =<< BitsDecl
+                              (pure decl)
+                              ident
+                              <$> advanceStage localState' typ
+                              <*> pure ann
+                  ObjTypeDecl _ ident body ann ->
+                    let qualifiedName = qualify (NonEmpty.singleton (identToString ident))
+                     in do
+                          typeSize <- calculateTypeSize =<< resolveOrFail body
+                          let decl =
+                                ExportedTypeDecl
+                                  (metadata qualifiedName)
+                                  typeSize
+                          insertDecl decl
+                          doReturn
+                            =<< ObjTypeDecl
+                              (pure decl)
+                              ident
+                              <$> mapM (advanceStage localState') body
+                              <*> pure ann
+                  ObjectDecl _ ident loc typ ann ->
+                    let qualifiedName = qualify (NonEmpty.singleton (identToString ident))
+                     in do
+                          location <- resolveLocationExpression localState' loc
+                          exportedType <- objTypeToExport localState' typ
+                          let decl =
+                                ExportedObjectDecl
+                                  (metadata qualifiedName)
+                                  location
+                                  exportedType
+                          insertDecl decl
+                          doReturn
+                            =<< ObjectDecl
+                              (pure decl)
+                              ident
+                              <$> advanceStage localState' loc
+                              <*> advanceStage localState' typ
+                              <*> pure ann
     )
-    ([], scopePath)
+    ([], localState)
     decls
+
+insertDecl :: (ExportableDecl d) => d -> M ()
+insertDecl decl =
+  modify $ \(GlobalState ui) -> GlobalState (UnitInterface.insert decl ui)
+
+objTypeToExport :: LocalState -> ObjType Expanded F A -> M ReferencedObjectType
+objTypeToExport ls = \case
+  ArrayObjType {arraySize = size, arrayObjType = objType} ->
+    ArrayObjectType
+      <$> objTypeToExport ls objType
+      <*> expressionToIntM size
+  ReferencedObjType {refName = n} -> do
+    (full, _ :: ExportedTypeDecl) <- resolveOrFail =<< resolveName n ls
+    return $ ReferencedObjectType (intercalate "." full)
+
+calculateTypeSize :: ObjTypeBody Expanded F A -> M Word32
+calculateTypeSize (ObjTypeBody bodyType decls _) =
+  ( case bodyType of
+      Union {} -> maximum
+      Struct {} -> sum
+  )
+    <$> mapM calculateDeclSize decls
+  where
+    calculateDeclSize :: Directed ObjTypeDecl Expanded F A -> M Word32
+    calculateDeclSize (undirected -> decl) =
+      case decl of
+        AssertPosStatement {} -> return 0
+        RegisterDecl {regSize = size} -> expressionToIntM size
+        ReservedDecl {reservedExpr = size} -> expressionToIntM size
+        TypeSubStructure {subStructureBody = b} -> calculateTypeSize =<< resolveOrFail b
+
+getBitTypeDeclaredSize :: BitType Expanded F A -> M Word32
+getBitTypeDeclaredSize = \case
+  (EnumBitType declaredSize _ _) -> expressionToIntM declaredSize
+  (RawBits declaredSize _) -> expressionToIntM declaredSize
+
+resolveLocationExpression ::
+  (Integral i, Integral (NumberType stage)) =>
+  LocalState ->
+  Expression stage F A ->
+  M i
+resolveLocationExpression ls (Var var _) = do
+  (_, ExportedLocationDecl _ v) <- resolveOrFail =<< resolveName var ls
+  return (fromIntegral v)
+resolveLocationExpression _ e = expressionToIntM e
+
+expressionToIntM ::
+  (Integral i, Integral (NumberType stage)) =>
+  Expression stage f A ->
+  M i
+expressionToIntM expr =
+  resolveOrFail $
+    either
+      ( \reason -> Left [Diagnostic Error reason (unCommented $ annot expr)]
+      )
+      return
+      (expressionToInt expr)