Implement qualification.

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

I'm getting close to implementing a backend.

15 files changed, 837 insertions, 745 deletions

diff --git a/goal.fiddle b/goal.fiddle
index a7f43f0..8b8a93b 100644
--- a/goal.fiddle
+++ b/goal.fiddle
@@ -131,7 +131,7 @@ package stm32l4.gpio {
 
         assert_pos(0x12);
         wo reg alt_r2(8);
-        reserved(8);
+        reserved(1);
       };
     };
     assert_pos(0x14);
diff --git a/src/Language/Fiddle/Ast.hs b/src/Language/Fiddle/Ast.hs
index a6ea87a..f5fbafe 100644
--- a/src/Language/Fiddle/Ast.hs
+++ b/src/Language/Fiddle/Ast.hs
@@ -8,3 +8,4 @@ import Language.Fiddle.Ast.Internal.Instances as X
 import Language.Fiddle.Ast.Internal.Kinds as X
 import Language.Fiddle.Ast.Internal.Stage as X
 import Language.Fiddle.Ast.Internal.SyntaxTree as X
+import Language.Fiddle.Ast.Internal.Util as X
diff --git a/src/Language/Fiddle/Ast/Internal/Instances.hs b/src/Language/Fiddle/Ast/Internal/Instances.hs
index 232d5c0..aaa20b8 100644
--- a/src/Language/Fiddle/Ast/Internal/Instances.hs
+++ b/src/Language/Fiddle/Ast/Internal/Instances.hs
@@ -120,8 +120,8 @@ class
       stage
       ( t
           (StageAfter stage) -- The next stage in the pipeline
-          (StageFunctor stage) -- The functor associated with the next stage
-          (StageAnnotation stage) -- Annotation type for the next stage
+          (StageFunctor stage) -- The functor associated with this stage
+          (StageAnnotation stage) -- Annotation type for this stage
       )
 
   -- | Default implementation of 'advanceStage' using generics. This leverages
@@ -311,6 +311,12 @@ instance
     K1 <$> ffn newK
 
 instance
+  (Traversable f1) =>
+  GAlter t f1 f2 a1 a2 (Rec0 (f1 x)) (Rec0 (f2 x))
+  where
+  galter _ ffn _ (K1 k) = K1 <$> ffn k
+
+instance
   ( GAlter t f1 f2 a1 a2 l1 l2,
     GAlter t f1 f2 a1 a2 r1 r2
   ) =>
diff --git a/src/Language/Fiddle/Ast/Internal/Instances/Walk.hs b/src/Language/Fiddle/Ast/Internal/Instances/Walk.hs
index d80963d..221dd5b 100644
--- a/src/Language/Fiddle/Ast/Internal/Instances/Walk.hs
+++ b/src/Language/Fiddle/Ast/Internal/Instances/Walk.hs
@@ -1,8 +1,16 @@
-module Language.Fiddle.Ast.Internal.Instances.Walk (Walk (..), GWalk (..)) where
+module Language.Fiddle.Ast.Internal.Instances.Walk (Walk (..), GWalk (..), walk_) where
 
 import Data.Typeable
 import GHC.Generics
 
+-- | Like walk, but assumes no local state.
+walk_ ::
+  (Monad m, Traversable f, Typeable f, Typeable a, Walk t) =>
+  (forall t'. (Walk t', Typeable t', Typeable f, Typeable a) => t' f a -> m ()) ->
+  t f a ->
+  m ()
+walk_ fn t = walk (\t _ -> fn t) t ()
+
 class (Typeable t) => Walk t where
   walk ::
     (Monad m, Traversable f, Typeable f, Typeable a) =>
diff --git a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
index 8e3cd6c..73c4303 100644
--- a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
+++ b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
@@ -12,6 +12,7 @@ module Language.Fiddle.Ast.Internal.SyntaxTree
     ImportInterface,
     FiddleUnitInterface,
     QualificationMetadata,
+    CommonQualificationData (..),
     -- Witness Types
     Witness (..),
     WitnessType,
@@ -48,18 +49,13 @@ module Language.Fiddle.Ast.Internal.SyntaxTree
     mapDirectedM,
     asDirected,
     undirected,
-    -- Utility Functions
-    squeeze,
-    nameToList,
   )
 where
 
 import Control.Monad (forM_)
-import Data.Functor.Identity
 import Data.Kind (Type)
 import Data.List.NonEmpty hiding (map)
 import Data.Text (Text)
-import qualified Data.Text as Text
 import Data.Type.Bool
 import Data.Typeable
 import Data.Void (Void)
@@ -67,11 +63,11 @@ import GHC.Generics
 import Language.Fiddle.Ast.Internal.Instances
 import Language.Fiddle.Ast.Internal.Kinds
 import Language.Fiddle.Ast.Internal.Stage
-import Language.Fiddle.Internal.UnitInterface (UnitInterface)
+import Language.Fiddle.Internal.UnitInterface
 
 -- | Common data for each qualified element.
-newtype CommonQualifcationData
-  = CommonQualifcationData
+newtype CommonQualificationData
+  = CommonQualificationData
   { -- The fully qualified path to this qualified element.
     fullyQualifiedPath :: [String]
   }
@@ -79,7 +75,7 @@ newtype CommonQualifcationData
 
 type family QualificationMetadata stage t where
   QualificationMetadata stage t =
-    If (stage < Qualified) () (CommonQualifcationData, t)
+    If (stage < Qualified) () t
 
 -- | The type attached to import statements which describe the imported file's
 -- unit interface
@@ -278,7 +274,7 @@ data Expression (s :: Stage) :: SynTree where
   -- | A variable reference.
   Var ::
     { -- | The identifier of the variable.
-      varIdentifier :: Identifier f a,
+      varIdentifier :: Name f a,
       -- | Annotation for the variable.
       varAnnot :: a
     } ->
@@ -348,7 +344,8 @@ data FiddleDecl :: StagedSynTree where
   -- | A package declaration.
   PackageDecl ::
     { -- | Qualification metadata about this package statement.
-      packageQualificationMetadata :: QualificationMetadata stage (),
+      packageQualificationMetadata ::
+        f (QualificationMetadata stage ExportedPackageDecl),
       -- | The package name.
       packageName :: Name f a,
       -- | The body of the package.
@@ -360,7 +357,8 @@ data FiddleDecl :: StagedSynTree where
   -- | A location declaration in the form 'location <identifier> = <expr>'.
   LocationDecl ::
     { -- | qualified metadata about this location.
-      locationQualificationMetadata :: QualificationMetadata stage (),
+      locationQualificationMetadata ::
+        f (QualificationMetadata stage ExportedLocationDecl),
       -- | The location identifier.
       locationIdent :: Identifier f a,
       -- | The associated expression.
@@ -372,7 +370,7 @@ data FiddleDecl :: StagedSynTree where
   -- | A bits declaration in the form 'bits <identifier> : <type>'.
   BitsDecl ::
     { -- | Qualification metadata about this "bits" declaration.
-      bitsQualificationMetadata :: QualificationMetadata stage (),
+      bitsQualificationMetadata :: f (QualificationMetadata stage ExportedBitsDecl),
       -- | The identifier of the bits.
       bitsIdent :: Identifier f a,
       -- | The type of the bits.
@@ -384,7 +382,7 @@ data FiddleDecl :: StagedSynTree where
   -- | An object type declaration.
   ObjTypeDecl ::
     { -- | Qualification metadata about this object type.
-      objTypeQualificationMetadata :: QualificationMetadata stage (),
+      objTypeQualificationMetadata :: f (QualificationMetadata stage ExportedTypeDecl),
       -- | The identifier of the object type.
       objTypeIdent :: Identifier f a,
       -- | The body of the object type.
@@ -396,7 +394,7 @@ data FiddleDecl :: StagedSynTree where
   -- | An object declaration in the form 'object <ident> at <expr> : <type>'.
   ObjectDecl ::
     { -- | Qualification metadata about this object.
-      objectQualificationMetadata :: QualificationMetadata stage (),
+      objectQualificationMetadata :: f (QualificationMetadata stage ExportedObjectDecl),
       -- | The identifier of the object.
       objectIdent :: Identifier f a,
       -- | The location expression.
@@ -448,7 +446,7 @@ data ObjType stage f a where
     ObjType stage f a
   -- | A reference to an existing type by name.
   ReferencedObjType ::
-    { refQualificationMetadata :: QualificationMetadata stage (),
+    { refQualificationMetadata :: f (QualificationMetadata stage ExportedTypeDecl),
       -- | The name of the referenced type.
       refName :: Name f a,
       -- | Annotation for the referenced type.
@@ -609,7 +607,7 @@ data RegisterBitsTypeRef stage f a where
   -- | A reference to another type by name.
   RegisterBitsReference ::
     { -- | Qualification metadata about this Bits reference.
-      bitsRefQualificationMetadata :: QualificationMetadata stage (),
+      bitsRefQualificationMetadata :: f (QualificationMetadata stage ExportedBitsDecl),
       -- | The name of the referenced type.
       bitsRefName :: Name f a,
       -- | Annotation for the reference.
@@ -714,9 +712,3 @@ data PackageBody (stage :: Stage) (f :: Type -> Type) a where
     } ->
     PackageBody stage f a
   deriving (Generic, Annotated, Typeable, Alter, Walk)
-
-squeeze :: (Alter t, Traversable f, Monad f) => t f a -> f (t Identity a)
-squeeze = alter (fmap Identity) return
-
-nameToList :: Name f a -> [String]
-nameToList (Name ids _) = map (Text.unpack . identifierName) (toList ids)
diff --git a/src/Language/Fiddle/Compiler.hs b/src/Language/Fiddle/Compiler.hs
index c029765..049d533 100644
--- a/src/Language/Fiddle/Compiler.hs
+++ b/src/Language/Fiddle/Compiler.hs
@@ -6,6 +6,7 @@ module Language.Fiddle.Compiler where
 
 import Control.Arrow
 import Control.Monad (when)
+import Control.Monad.Identity (Identity)
 import Control.Monad.RWS
 import Control.Monad.Trans.Maybe
 import Control.Monad.Writer
@@ -21,6 +22,15 @@ data Level = Error | Warning | Info
 
 data Diagnostic = Diagnostic Level String SourceSpan
 
+emitDiagnosticError :: String -> Commented SourceSpan -> Compile a ()
+emitDiagnosticError str a = tell [Diagnostic Error str (unCommented a)]
+
+emitDiagnosticWarning :: String -> Commented SourceSpan -> Compile a ()
+emitDiagnosticWarning str a = tell [Diagnostic Warning str (unCommented a)]
+
+emitDiagnosticInfo :: String -> Commented SourceSpan -> Compile a ()
+emitDiagnosticInfo str a = tell [Diagnostic Info str (unCommented a)]
+
 newtype Compile s a = Compile (MaybeT (RWS () [Diagnostic] s) a)
   deriving newtype (Functor, Applicative, Monad)
 
@@ -103,13 +113,13 @@ pureCompilationPhase ::
   (CompilationStage stageFrom) =>
   ( FiddleUnit
       stageFrom
-      (StageFunctor stageFrom)
+      Identity
       (StageAnnotation stageFrom) ->
     Compile
       ()
       ( FiddleUnit
           stageTo
-          (StageFunctor stageTo)
+          Identity
           (StageAnnotation stageTo)
       )
   ) ->
@@ -138,7 +148,7 @@ data CompilationPhase stageFrom stageTo where
       -- only time a side effect may be performed.
       ioAction ::
         privateFlags ->
-        TreeType FiddleUnit Parsed ->
+        FiddleUnit Parsed Identity (StageAnnotation Parsed) ->
         IO ([Diagnostic], Maybe privateState),
       -- | 'nextStage' is the function that transforms a 'FiddleUnit' from
       -- the current stage ('stageFrom') to the next stage ('stageTo'). It
@@ -149,13 +159,13 @@ data CompilationPhase stageFrom stageTo where
         privateState ->
         FiddleUnit
           stageFrom
-          (StageFunctor stageFrom)
+          Identity
           (StageAnnotation stageFrom) ->
         Compile
           ()
           ( FiddleUnit
               stageTo
-              (StageFunctor stageTo)
+              Identity
               (StageAnnotation stageTo)
           )
     } ->
@@ -198,11 +208,11 @@ thenPhase
 execCompilationPipelineWithCmdline ::
   CompilationPhase Parsed s' ->
   Parser
-    ( FiddleUnit Parsed (StageFunctor Parsed) (StageAnnotation Parsed) ->
+    ( FiddleUnit Parsed Identity (StageAnnotation Parsed) ->
       IO
         ( [Diagnostic],
           Maybe
-            ( FiddleUnit s' (StageFunctor s') (StageAnnotation s')
+            ( FiddleUnit s' Identity (StageAnnotation s')
             )
         )
     )
@@ -216,3 +226,22 @@ execCompilationPipelineWithCmdline
             Nothing -> return (diags, Nothing)
       )
       flagsParser
+
+squeezeDiagnostics :: (Alter t) => t (Either [Diagnostic]) a -> Compile () (t Identity a)
+squeezeDiagnostics ast = do
+  _ <-
+    alter
+      ( \case
+          (Left l) -> tell l >> return (Left l)
+          r -> return r
+      )
+      return
+      ast
+
+  case squeeze ast of
+    (Left _) -> compilationFailure
+    (Right a) -> return a
+
+resolveOrFail :: Either [Diagnostic] a -> Compile s a
+resolveOrFail (Right a) = return a
+resolveOrFail (Left l) = tell l >> compilationFailure
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)
diff --git a/src/Language/Fiddle/GenericTree.hs b/src/Language/Fiddle/GenericTree.hs
index f0ac96a..165949a 100644
--- a/src/Language/Fiddle/GenericTree.hs
+++ b/src/Language/Fiddle/GenericTree.hs
@@ -10,6 +10,7 @@
 
 module Language.Fiddle.GenericTree where
 
+import Control.Monad.Identity (Identity)
 import Data.Aeson.Encoding (text)
 import Data.Aeson.Types as Aeson
 import Data.Foldable (Foldable (toList))
@@ -20,6 +21,7 @@ import qualified Data.Vector
 import GHC.Generics
 import GHC.TypeLits (KnownSymbol, symbolVal)
 import Language.Fiddle.Ast
+import Language.Fiddle.Internal.UnitInterface
 import Language.Fiddle.Types
 
 type Context stage =
@@ -28,9 +30,26 @@ type Context stage =
     ToGenericSyntaxTreeValue (NumberType stage),
     Show (ImportInterface stage),
     Show (FiddleUnitInterface stage),
-    Show (QualificationMetadata stage ())
+    Show (QualificationMetadata stage ()),
+    Show (QualificationMetadata stage ExportedPackageDecl),
+    Show (QualificationMetadata stage ExportedLocationDecl),
+    Show (QualificationMetadata stage ExportedBitsDecl),
+    Show (QualificationMetadata stage ExportedTypeDecl),
+    Show (QualificationMetadata stage ExportedObjectDecl)
   )
 
+class FunctorShow f where
+  showf :: (Show a) => f a -> String
+
+instance (Show l) => FunctorShow (Either l) where
+  showf = show
+
+instance FunctorShow Maybe where
+  showf = show
+
+instance FunctorShow Identity where
+  showf = show
+
 data GenericSyntaxTree f a where
   {- GenericSyntaxtTree with a name and children. -}
   SyntaxTreeObject ::
@@ -103,6 +122,9 @@ class ToGenericSyntaxTreeValue v where
     forall f a. (Show v) => v -> Maybe (GenericSyntaxTree f a)
   toGenericSyntaxTreeValue = Just . SyntaxTreeValue . show
 
+instance ToGenericSyntaxTreeValue (f a) where
+  toGenericSyntaxTreeValue = const Nothing
+
 instance ToGenericSyntaxTreeValue Data.Text.Text where
   toGenericSyntaxTreeValue = Just . SyntaxTreeValue . Data.Text.unpack
 
@@ -140,6 +162,11 @@ instance
   gToGenericSyntaxTree _ k1 = SyntaxTreeDeferred (toGenericSyntaxTree <$> unK1 k1)
 
 instance
+  GToGenericSyntaxTree (Rec0 (f x)) f a
+  where
+  gToGenericSyntaxTree _ k1 = SyntaxTreeList []
+
+instance
   (GenericContext r f a, Traversable f1) =>
   GToGenericSyntaxTree (Rec0 (f1 (r f a))) f a
   where
@@ -157,6 +184,7 @@ instance
 instance (GenericContext t f a) => GToMemberList (Rec0 (t f a)) f a where
   gToMemberList _ a = [toGenericSyntaxTree (unK1 a)]
 
+
 instance
   (GenericContext t f a, Foldable l) =>
   GToMemberList (Rec0 (l (t f a))) f a
diff --git a/src/Language/Fiddle/Internal/Scopes.hs b/src/Language/Fiddle/Internal/Scopes.hs
index 70cadee..c232328 100644
--- a/src/Language/Fiddle/Internal/Scopes.hs
+++ b/src/Language/Fiddle/Internal/Scopes.hs
@@ -2,20 +2,22 @@
 
 module Language.Fiddle.Internal.Scopes where
 
+import Data.Foldable
 import Data.Aeson
 import Data.Aeson.Key
 import Data.List (inits)
 import Data.List.NonEmpty (NonEmpty (..), prependList)
 import Data.Map (Map)
 import qualified Data.Map as Map
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, maybeToList)
+import Control.Arrow (Arrow(first))
 
 -- | 'Scope' represents a hierarchical structure for storing key-value pairs.
 --   It can contain nested sub-scopes, which are stored in 'subScopes',
 --   and the values for a specific scope are stored in 'scopeValues'.
 data Scope k v = Scope
   { subScopes :: Map k (Scope k v), -- Nested sub-scopes
-    scopeValues :: Map k v -- Values stored in the current scope
+    scopeValues :: Map k [v] -- Values stored in the current scope
   }
   deriving (Eq, Ord, Show, Read, Functor, Foldable)
 
@@ -29,24 +31,24 @@ data ScopePath k = ScopePath
   deriving (Eq, Ord, Show, Read)
 
 -- | Qualify a name with the current scope.
-qualifyPath :: ScopePath k -> k -> [k]
-qualifyPath ScopePath {currentScope = scope} k = scope ++ [k]
+qualifyPath :: ScopePath k -> NonEmpty k -> NonEmpty k
+qualifyPath ScopePath {currentScope = scope} = prependList scope
 
 -- | Push a new scope onto the current scope.
-pushScope :: k -> ScopePath k -> ScopePath k
+pushScope :: NonEmpty k -> ScopePath k -> ScopePath k
 pushScope v s@ScopePath {currentScope = scope} =
-  s {currentScope = scope ++ [v]}
+  s {currentScope = scope ++ toList v}
 
 -- | Adds a path to the "using" paths.
-addUsingPath :: [k] -> ScopePath k -> ScopePath k
+addUsingPath :: NonEmpty k -> ScopePath k -> ScopePath k
 addUsingPath path s@ScopePath {usingPaths = paths} =
-  s {usingPaths = path : paths}
+  s {usingPaths = toList path : paths}
 
 -- | The 'Semigroup' instance for 'Scope' allows combining two scopes,
 --   where sub-scopes and values are merged together.
 instance (Ord k) => Semigroup (Scope k t) where
   (Scope ss1 sv1) <> (Scope ss2 sv2) =
-    Scope (Map.unionWith (<>) ss1 ss2) (Map.union sv1 sv2)
+    Scope (Map.unionWith (<>) ss1 ss2) (Map.unionWith (<>) sv1 sv2)
 
 -- | The 'Monoid' instance for 'Scope' provides an empty scope with
 --   no sub-scopes or values.
@@ -71,9 +73,10 @@ instance Monoid (ScopePath k) where
 --   This function effectively performs an "insert-or-update" operation, allowing
 --   you to upsert values into nested scopes while tracking any existing value
 --   that was replaced.
-upsertScope :: (Ord k) => NonEmpty k -> t -> Scope k t -> (Maybe t, Scope k t)
+upsertScope :: (Ord k) => NonEmpty k -> t -> Scope k t -> ([t], Scope k t)
 upsertScope (s :| []) v (Scope ss sv) =
-  Scope ss <$> Map.insertLookupWithKey (\_ n _ -> n) s v sv
+  first (fromMaybe []) $
+    Scope ss <$> Map.insertLookupWithKey (const (<>)) s [v] sv
 upsertScope (s :| (a : as)) v (Scope ss sv) =
   let subscope = fromMaybe mempty (Map.lookup s ss)
       (replaced, subscope') = upsertScope (a :| as) v subscope
@@ -82,15 +85,18 @@ upsertScope (s :| (a : as)) v (Scope ss sv) =
 insertScope :: (Ord k) => NonEmpty k -> t -> Scope k t -> Scope k t
 insertScope p s = snd . upsertScope p s
 
+singleton :: (Ord k) => NonEmpty k -> t -> Scope k t
+singleton ks t = insertScope ks t mempty
+
 -- insertScope :: (Ord k) => NonEmpty k -> t -> Scope k t -> Scope k t
 -- insertScope a b = snd . upsertScope a b
 
 -- | 'lookupScope' performs a lookup of a value in the scope using a key path
 --   ('NonEmpty k'). It traverses through sub-scopes as defined by the path.
-lookupScope :: (Ord k) => NonEmpty k -> Scope k t -> Maybe t
-lookupScope (s :| []) (Scope _ sv) = Map.lookup s sv
+lookupScope :: (Ord k) => NonEmpty k -> Scope k t -> [t]
+lookupScope (s :| []) (Scope _ sv) = fromMaybe [] $ Map.lookup s sv
 lookupScope (s :| (a : as)) (Scope ss _) = do
-  subscope <- Map.lookup s ss
+  subscope <- maybeToList $ Map.lookup s ss
   lookupScope (a :| as) subscope
 
 -- | 'lookupScopeWithPath' searches for a key in the scope by trying all possible
@@ -122,10 +128,16 @@ lookupScopeWithPath ::
   [(NonEmpty k, t)]
 lookupScopeWithPath (ScopePath current others) key scope =
   let allPaths = reverse (inits current) ++ others
-   in flip concatMap allPaths $ \prefix -> do
-        case lookupScope (prependList prefix key) scope of
-          Just s -> [(prependList prefix key, s)]
-          Nothing -> []
+   in do
+        prefix <- allPaths
+        let qualifiedKey = prependList prefix key
+        value <- lookupScope qualifiedKey scope
+        return (qualifiedKey, value)
+
+-- flip concatMap allPaths $ \prefix -> do
+--      case lookupScope (prependList prefix key) scope of
+--        Just s -> [(prependList prefix key, s)]
+--        Nothing -> []
 
 instance (ToJSONKey k, ToJSON v, Ord k) => ToJSON (Scope k v) where
   toJSON scope =
diff --git a/src/Language/Fiddle/Internal/UnitInterface.hs b/src/Language/Fiddle/Internal/UnitInterface.hs
index aacb71d..c5cbc2c 100644
--- a/src/Language/Fiddle/Internal/UnitInterface.hs
+++ b/src/Language/Fiddle/Internal/UnitInterface.hs
@@ -1,14 +1,19 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 module Language.Fiddle.Internal.UnitInterface where
 
 import Data.Aeson
+import Data.List.NonEmpty (NonEmpty)
 import Data.Text
 import Data.Word
 import GHC.Generics
 import Language.Fiddle.Internal.Scopes (Scope)
+import qualified Language.Fiddle.Internal.Scopes as Scopes
 import Language.Fiddle.Types (SourceSpan)
 
+data InternalDirectiveExpression
+  = InternalDirectiveExpressionNumber String
+  | InternalDirectiveExpressionString String
+  deriving (Generic, ToJSON, FromJSON, Show, Eq, Ord)
+
 -- | Represents a compiler directive that provides configuration for the compiler
 --   or its various backends. Directives can adjust the behavior of the compiler
 --   or influence the code generation in the backends.
@@ -21,7 +26,7 @@ data InternalDirective = InternalDirective
     directiveKey :: String,
     -- | The optional value associated with this directive. Some directives
     --   may not require a value (e.g., flags), in which case this field is 'Nothing'.
-    directiveValue :: Maybe String
+    directiveValue :: Maybe InternalDirectiveExpression
   }
   deriving (Generic, ToJSON, FromJSON, Show, Eq, Ord)
 
@@ -29,7 +34,9 @@ data InternalDirective = InternalDirective
 -- location, doc comments and compiler directives associated with the exported
 -- symbol.
 data Metadata = Metadata
-  { -- | Source location for the exported symbol.
+  { -- | Fully-qualified path the the element.
+    metadataFullyQualifiedPath :: NonEmpty String,
+    -- | Source location for the exported symbol.
     metadataSourceSpan :: SourceSpan,
     -- | Doc comment associated with the symbol.
     metadataDocComment :: Text,
@@ -44,11 +51,23 @@ data Metadata = Metadata
 -- direct dependencies.
 data UnitInterface where
   UnitInterface ::
-    { rootScope :: Scope String (Metadata, ExportedValue),
+    { rootScope :: Scope String (Metadata, ExportedDecl),
       dependencies :: [FilePath]
     } ->
     UnitInterface
-  deriving (Eq, Ord, Show)
+  deriving (Generic, Eq, Ord, Show, FromJSON, ToJSON)
+
+insert :: (ExportableDecl d) => d -> UnitInterface -> UnitInterface
+insert decl (UnitInterface sc deps) =
+  let metadata = getMetadata decl
+      path = metadataFullyQualifiedPath metadata
+   in UnitInterface (Scopes.insertScope path (metadata, toExportedDecl decl) sc) deps
+
+singleton :: (ExportableDecl d) => d -> UnitInterface
+singleton decl =
+  let path = metadataFullyQualifiedPath (getMetadata decl)
+      metadata = getMetadata decl
+   in UnitInterface (Scopes.singleton path (metadata, toExportedDecl decl)) []
 
 instance Semigroup UnitInterface where
   (<>) (UnitInterface s d) (UnitInterface s1 d1) =
@@ -57,24 +76,128 @@ instance Semigroup UnitInterface where
 instance Monoid UnitInterface where
   mempty = UnitInterface mempty mempty
 
-data ExportedValue where
-  ExportedBitsType ::
-    {exportBitsTypeSize :: Word32} ->
-    ExportedValue
-  ExportedObjType ::
-    {exportObjTypeSize :: Word32} ->
-    ExportedValue
+-- | Represents an exported package declaration in the syntax tree.
+-- This is a higher-level abstraction with metadata detailing the package.
+data ExportedPackageDecl where
+  ExportedPackageDecl ::
+    { -- | Metadata associated with the package.
+      exportedPackageMetadata :: Metadata
+    } ->
+    ExportedPackageDecl
+  deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
+
+-- | Represents an exported location declaration in the syntax tree.
+-- Contains metadata and the actual integer value of the location.
+data ExportedLocationDecl where
+  ExportedLocationDecl ::
+    { -- | Metadata associated with the location.
+      exportedLocationMetadata :: Metadata,
+      -- | The value of the location as an integer.
+      exportedLocationValue :: Integer
+    } ->
+    ExportedLocationDecl
   deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
 
-instance ToJSON UnitInterface where
-  toJSON ui =
-    object
-      [ "rootScope" .= rootScope ui,
-        "dependencies" .= dependencies ui
-      ]
+-- | Represents an exported bits declaration in the syntax tree.
+-- Contains metadata and the size of the bits in a Word32 format.
+data ExportedBitsDecl where
+  ExportedBitsDecl ::
+    { -- | Metadata associated with the bits declaration.
+      exportedBitsDeclMetadata :: Metadata,
+      -- | The size of the bits in this declaration.
+      exportedBitsDeclSizeBits :: Word32
+    } ->
+    ExportedBitsDecl
+  deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
 
-instance FromJSON UnitInterface where
-  parseJSON = withObject "UnitInterface" $ \v ->
-    UnitInterface
-      <$> v .: "rootScope"
-      <*> v .: "dependencies"
+-- | Represents an exported type declaration in the syntax tree.
+-- Contains metadata and the size of the type in bytes.
+data ExportedTypeDecl where
+  ExportedTypeDecl ::
+    { -- | Metadata associated with the type declaration.
+      exportedTypeDeclMetadata :: Metadata,
+      -- | The size of the type in bytes.
+      exportedTypeDeclSizeBytes :: Word32
+    } ->
+    ExportedTypeDecl
+  deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
+
+data ReferencedObjectType where
+  ReferencedObjectType ::
+    {objectTypeReference :: String} -> ReferencedObjectType
+  ArrayObjectType ::
+    { arrayObjectTypeType :: ReferencedObjectType,
+      arryObjecttTypeNumber :: Word32
+    } ->
+    ReferencedObjectType
+  deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
+
+-- | Represents an exported object declaration in the syntax tree.
+-- This includes metadata, location, and the type of the object.
+data ExportedObjectDecl where
+  ExportedObjectDecl ::
+    { -- | Metadata associated with the object declaration.
+      exportedObjectDeclMetadata :: Metadata,
+      -- | The memory location of the object.
+      exportedObjectDeclLocation :: Integer,
+      -- | The type of the object as a string.
+      exportedObjectDeclType :: ReferencedObjectType
+    } ->
+    ExportedObjectDecl
+  deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
+
+-- | A typeclass for converting various exported declarations into the
+-- generalized 'ExportedDecl' type. This allows treating different exported
+-- declarations uniformly in the compilation process.
+class ExportableDecl a where
+  toExportedDecl :: a -> ExportedDecl
+  fromExportedDecl :: ExportedDecl -> Maybe a
+  getMetadata :: a -> Metadata
+
+-- Instances of 'ExportableDecl' to convert specific exported declaration types
+-- into the generalized 'ExportedDecl' type.
+instance ExportableDecl ExportedPackageDecl where
+  toExportedDecl = ExportedPackage
+  fromExportedDecl = \case
+    ExportedPackage x -> Just x
+    _ -> Nothing
+  getMetadata = exportedPackageMetadata
+
+instance ExportableDecl ExportedLocationDecl where
+  toExportedDecl = ExportedLocation
+  fromExportedDecl = \case
+    ExportedLocation x -> Just x
+    _ -> Nothing
+  getMetadata = exportedLocationMetadata
+
+instance ExportableDecl ExportedBitsDecl where
+  toExportedDecl = ExportedBits
+  fromExportedDecl = \case
+    ExportedBits x -> Just x
+    _ -> Nothing
+  getMetadata = exportedBitsDeclMetadata
+
+instance ExportableDecl ExportedTypeDecl where
+  toExportedDecl = ExportedType
+  fromExportedDecl = \case
+    ExportedType x -> Just x
+    _ -> Nothing
+  getMetadata = exportedTypeDeclMetadata
+
+instance ExportableDecl ExportedObjectDecl where
+  toExportedDecl = ExportedObject
+  fromExportedDecl = \case
+    ExportedObject x -> Just x
+    _ -> Nothing
+  getMetadata = exportedObjectDeclMetadata
+
+-- | A generalized representation of different exported declarations.
+-- This data type allows for a uniform way to handle various exportable
+-- syntax tree elements (e.g., packages, locations, bits, types, objects).
+data ExportedDecl where
+  ExportedPackage :: ExportedPackageDecl -> ExportedDecl
+  ExportedLocation :: ExportedLocationDecl -> ExportedDecl
+  ExportedBits :: ExportedBitsDecl -> ExportedDecl
+  ExportedType :: ExportedTypeDecl -> ExportedDecl
+  ExportedObject :: ExportedObjectDecl -> ExportedDecl
+  deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
diff --git a/src/Language/Fiddle/Parser.hs b/src/Language/Fiddle/Parser.hs
index 00cce27..a2368ed 100644
--- a/src/Language/Fiddle/Parser.hs
+++ b/src/Language/Fiddle/Parser.hs
@@ -137,15 +137,15 @@ fiddleDeclP = do
     case t of
       KWOption -> OptionDecl <$> nextTextP <*> nextTextP
       KWPackage ->
-        PackageDecl ()
+        PackageDecl (pure ())
           <$> name
           <*> defer body packageBodyP
       KWUsing -> UsingDecl (Witness ()) <$> name
-      KWLocation -> LocationDecl () <$> ident <*> (tok TokEq >> expressionP)
-      KWBits -> BitsDecl () <$> ident <*> (tok TokColon >> bitTypeP)
+      KWLocation -> LocationDecl (pure ()) <$> ident <*> (tok TokEq >> expressionP)
+      KWBits -> BitsDecl (pure ()) <$> ident <*> (tok TokColon >> bitTypeP)
       KWImport -> ImportDecl <$> importStatementP
       KWType ->
-        ObjTypeDecl ()
+        ObjTypeDecl (pure ())
           <$> ident
           <*> ( do
                   tok_ TokColon
@@ -153,7 +153,7 @@ fiddleDeclP = do
                   defer body (objTypeBodyP bt)
               )
       KWInstance ->
-        ObjectDecl ()
+        ObjectDecl (pure ())
           <$> ident
           <*> (tok KWAt *> expressionP)
           <*> (tok TokColon *> objTypeP)
@@ -179,7 +179,7 @@ objTypeP = do
 
     baseObjP :: P (A -> ObjType Parsed F A)
     baseObjP =
-      (ReferencedObjType () <$> name)
+      (ReferencedObjType (pure ()) <$> name)
         <|> ( do
                 t <- bodyTypeP
                 AnonymousObjType (Witness ()) <$> defer body (objTypeBodyP t)
@@ -279,7 +279,7 @@ registerBitsTypeRefP = do
       withMeta $
         (RegisterBitsJustBits <$> exprInParenP)
           <|> (RegisterBitsAnonymousType (Witness ()) <$> anonymousBitsTypeP)
-          <|> (RegisterBitsReference () <$> name)
+          <|> (RegisterBitsReference (pure ()) <$> name)
 
 anonymousBitsTypeP :: Pa AnonymousBitsType
 anonymousBitsTypeP = withMeta $ do
@@ -307,12 +307,14 @@ enumConstantDeclP =
       <|> (EnumConstantDecl <$> ident <*> (tok TokEq >> expressionP))
 
 expressionP :: Pa Expression
-expressionP = withMeta $
-  token $ \case
-    (TokLitNum num) -> Just (LitNum num)
-    (TokIdent i) -> Just $
-      \(Commented cs s) -> Var (Identifier i (Commented [] s)) (Commented cs s)
-    _ -> Nothing
+expressionP =
+  withMeta $
+    token
+      ( \case
+          (TokLitNum num) -> Just (LitNum num)
+          _ -> Nothing
+      )
+      <|> (Var <$> name)
 
 body :: P [Token SourceSpan]
 body = do
diff --git a/src/Language/Fiddle/Types.hs b/src/Language/Fiddle/Types.hs
index 8b022cf..02e6fed 100644
--- a/src/Language/Fiddle/Types.hs
+++ b/src/Language/Fiddle/Types.hs
@@ -3,6 +3,7 @@
 module Language.Fiddle.Types where
 
 import Data.Aeson
+import Data.Maybe
 import Data.Text (Text, pack, splitOn, unpack)
 import Text.Parsec.Pos
 
@@ -18,6 +19,16 @@ data SourceSpan = SourceSpan
 data Commented a = Commented {comments :: ![Comment], unCommented :: !a}
   deriving (Show)
 
+docComments :: Commented a -> Text
+docComments =
+  mconcat
+    . mapMaybe
+      ( \case
+          (DocComment t) -> Just t
+          _ -> Nothing
+      )
+    . comments
+
 -- Helper to create the compressed span string
 formatSpan :: SourceSpan -> String
 formatSpan (SourceSpan ss se) =