Add empty qualification stage.

This stage will be responsible for qualifying all types and attaching
necessary  metadata to make the job of later stages much easier.

6 files changed, 147 insertions, 35 deletions

diff --git a/src/Language/Fiddle/Ast/Internal/Stage.hs b/src/Language/Fiddle/Ast/Internal/Stage.hs
index 17ec9f2..f175fc4 100644
--- a/src/Language/Fiddle/Ast/Internal/Stage.hs
+++ b/src/Language/Fiddle/Ast/Internal/Stage.hs
@@ -19,6 +19,7 @@ data Stage
   = Parsed
   | ImportsResolved
   | Expanded
+  | Qualified
   | Checked
   | End
   deriving (Typeable)
@@ -30,7 +31,8 @@ type family StageToNumber (s :: Stage) :: Natural where
   StageToNumber Parsed = 1
   StageToNumber ImportsResolved = 2
   StageToNumber Expanded = 3
-  StageToNumber Checked = 4
+  StageToNumber Qualified = 4
+  StageToNumber Checked = 5
 
 -- | A type-level constraint that checks if one compilation stage precedes another.
 --   It compares the numeric values associated with each stage using 'CmpNat'.
diff --git a/src/Language/Fiddle/Compiler.hs b/src/Language/Fiddle/Compiler.hs
index 24c7da0..a7b07ea 100644
--- a/src/Language/Fiddle/Compiler.hs
+++ b/src/Language/Fiddle/Compiler.hs
@@ -101,6 +101,24 @@ fromMayberOrFail sourceSpan err Nothing = do
   compilationFailure
 fromMayberOrFail _ _ (Just a) = return a
 
+pureCompilationPhase ::
+  (CompilationStage stageFrom) =>
+  ( FiddleUnit
+      stageFrom
+      (StageFunctor stageFrom)
+      (StageAnnotation stageFrom) ->
+    Compile
+      ()
+      ( FiddleUnit
+          stageTo
+          (StageFunctor stageTo)
+          (StageAnnotation stageTo)
+      )
+  ) ->
+  CompilationPhase stageFrom stageTo
+pureCompilationPhase fn =
+  CompilationPhase (pure ()) (\_ _ -> return ([], Just ())) (\_ _ -> fn)
+
 -- data IOActionExtraData = IOActionExtraData
 --   { parseFile :: FilePath -> IO (TreeType FiddleUnit Parsed),
 --     stage3Compile :: TreeType FiddleUnit Parsed ->
diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
index 3286e86..2f570a4 100644
--- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
+++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
@@ -46,6 +46,8 @@ data GlobalState = GlobalState
 
 newtype LocalState = LocalState (ScopePath String)
 
+type CurrentStage = Qualified
+
 type I = Identity
 
 type Annot = Commented SourceSpan
@@ -54,13 +56,11 @@ type SizeBits = Word32
 
 type SizeBytes = Word32
 
-consistencyCheckPhase ::
-  CompilationPhase Expanded Checked
-consistencyCheckPhase =
-  CompilationPhase (pure ()) (\_ _ -> return ([], Just ())) (\_ _ -> checkConsistency)
+consistencyCheckPhase :: CompilationPhase CurrentStage Checked
+consistencyCheckPhase = pureCompilationPhase checkConsistency
 
 checkConsistency ::
-  FiddleUnit Expanded I Annot ->
+  FiddleUnit CurrentStage I Annot ->
   Compile () (FiddleUnit Checked I Annot)
 checkConsistency =
   fmap snd
@@ -74,14 +74,14 @@ instance CompilationStage Checked where
   type StageFunctor Checked = Identity
   type StageAnnotation Checked = Commented SourceSpan
 
-instance CompilationStage Expanded where
-  type StageAfter Expanded = Checked
-  type StageMonad Expanded = Compile GlobalState
-  type StageState Expanded = LocalState
-  type StageFunctor Expanded = Identity
-  type StageAnnotation Expanded = 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 Expanded FiddleUnit where
+instance AdvanceStage CurrentStage FiddleUnit where
   advanceStage localState (FiddleUnit _ decls a) = do
     decls' <- mapM (advanceStage localState) decls
     intf <- gets unitInterface
@@ -91,27 +91,27 @@ instance AdvanceStage Expanded FiddleUnit where
 
 --   decls' <- mapM (advanceStage localState) decls
 
-deriving instance AdvanceStage Expanded Expression
+deriving instance AdvanceStage CurrentStage Expression
 
-deriving instance AdvanceStage Expanded ObjType
+deriving instance AdvanceStage CurrentStage ObjType
 
-deriving instance AdvanceStage Expanded DeferredRegisterBody
+deriving instance AdvanceStage CurrentStage DeferredRegisterBody
 
-deriving instance AdvanceStage Expanded RegisterBitsDecl
+deriving instance AdvanceStage CurrentStage RegisterBitsDecl
 
-deriving instance AdvanceStage Expanded RegisterBitsTypeRef
+deriving instance AdvanceStage CurrentStage RegisterBitsTypeRef
 
-deriving instance AdvanceStage Expanded AnonymousBitsType
+deriving instance AdvanceStage CurrentStage AnonymousBitsType
 
-deriving instance AdvanceStage Expanded BitType
+deriving instance AdvanceStage CurrentStage BitType
 
-deriving instance AdvanceStage Expanded EnumBody
+deriving instance AdvanceStage CurrentStage EnumBody
 
-deriving instance AdvanceStage Expanded EnumConstantDecl
+deriving instance AdvanceStage CurrentStage EnumConstantDecl
 
-deriving instance AdvanceStage Expanded PackageBody
+deriving instance AdvanceStage CurrentStage PackageBody
 
-instance AdvanceStage Expanded ImportStatement where
+instance AdvanceStage CurrentStage ImportStatement where
   modifyState
     ( ImportStatement
         { importInterface =
@@ -147,17 +147,17 @@ instance AdvanceStage Expanded ImportStatement where
                 ExportedObjType sz -> Right sz
             )
 
-deriving instance (AdvanceStage Expanded t) => AdvanceStage Expanded (Directed t)
+deriving instance (AdvanceStage CurrentStage t) => AdvanceStage CurrentStage (Directed t)
 
-instance AdvanceStage Expanded RegisterBody where
+instance AdvanceStage CurrentStage RegisterBody where
   advanceStage s body = fst <$> registerBodyToStage3 s body
 
-instance AdvanceStage Expanded ObjTypeBody where
+instance AdvanceStage CurrentStage ObjTypeBody where
   advanceStage s body = fst <$> objTypeBodyToStage3 s body 0
 
-deriving instance AdvanceStage Expanded FiddleDecl
+deriving instance AdvanceStage CurrentStage FiddleDecl
 
-instance AdvanceStage Expanded (Directed FiddleDecl) where
+instance AdvanceStage CurrentStage (Directed FiddleDecl) where
   modifyState (Directed directives t _) s = case t of
     (BitsDecl id typ annotation) -> do
       typeSize <- getTypeSize typ
@@ -200,7 +200,7 @@ nameToList (Name idents _) = map (\(Identifier (Text.unpack -> s) _) -> s) (toLi
 
 objTypeBodyToStage3 ::
   LocalState ->
-  ObjTypeBody Expanded I Annot ->
+  ObjTypeBody CurrentStage I Annot ->
   Word32 ->
   Compile GlobalState (ObjTypeBody Checked I Annot, Word32)
 objTypeBodyToStage3 st (ObjTypeBody bodyType decls a) startOff = do
@@ -354,7 +354,7 @@ objTypeBodyToStage3 st (ObjTypeBody bodyType decls a) startOff = do
 
 registerBodyToStage3 ::
   LocalState ->
-  RegisterBody Expanded I Annot ->
+  RegisterBody CurrentStage I Annot ->
   Compile GlobalState (RegisterBody Checked I Annot, Word32)
 registerBodyToStage3
   st
@@ -445,7 +445,7 @@ registerBodyToStage3
 
 registerBitsTypeRefToStage3 ::
   LocalState ->
-  RegisterBitsTypeRef Expanded I Annot ->
+  RegisterBitsTypeRef CurrentStage I Annot ->
   Compile GlobalState (RegisterBitsTypeRef Checked I Annot, Word32)
 registerBitsTypeRefToStage3 localState = \case
   RegisterBitsArray ref expr a -> do
@@ -535,7 +535,7 @@ lookupTypeSize (LocalState scopePath) (Name idents a) = do
         ]
       compilationFailure
 
-getTypeSize :: BitType Expanded I Annot -> Compile s SizeBits
+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
diff --git a/src/Language/Fiddle/Compiler/Expansion.hs b/src/Language/Fiddle/Compiler/Expansion.hs
index 1e8fbae..f10fa5f 100644
--- a/src/Language/Fiddle/Compiler/Expansion.hs
+++ b/src/Language/Fiddle/Compiler/Expansion.hs
@@ -18,7 +18,7 @@ import Debug.Trace
 import GHC.TypeLits
 import Language.Fiddle.Ast
 import Language.Fiddle.Compiler
-import Language.Fiddle.Compiler.ConsistencyCheck
+import Language.Fiddle.Compiler.Qualification
 import Language.Fiddle.Types
 import Text.Printf (printf)
 
diff --git a/src/Language/Fiddle/Compiler/Qualification.hs b/src/Language/Fiddle/Compiler/Qualification.hs
new file mode 100644
index 0000000..146fd61
--- /dev/null
+++ b/src/Language/Fiddle/Compiler/Qualification.hs
@@ -0,0 +1,88 @@
+-- | Qualification compilation phase.
+--
+-- The qualification phase is responsible for resolving all type references in
+-- the AST to their fully-qualified counterparts. This process involves
+-- replacing unqualified references with their fully-qualified names and
+-- attaching the necessary metadata to each reference. This enriched information
+-- is then available for use in later stages of the compilation pipeline.
+--
+-- In this phase, symbol resolution statements (such as 'using' statements) are
+-- removed, as they become unnecessary once references are fully qualified.
+-- Additionally, package structures are flattened, and package declarations are
+-- discarded since full qualification renders them redundant.
+module Language.Fiddle.Compiler.Qualification (qualificationPhase) where
+
+import Control.Monad.Identity
+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.Types
+
+type CurrentStage = Expanded
+
+data GlobalState = GlobalState
+  { globalScope :: Scope String (Either SizeBits SizeBytes),
+    fileDependencies :: [FilePath],
+    unitInterface :: UnitInterface
+  }
+
+newtype LocalState = LocalState (ScopePath String)
+
+type I = Identity
+
+type Annot = Commented SourceSpan
+
+type SizeBits = Word32
+
+type SizeBytes = Word32
+
+instance CompilationStage Expanded where
+  type StageAfter Expanded = Qualified
+  type StageMonad Expanded = Compile GlobalState
+  type StageState Expanded = LocalState
+  type StageFunctor Expanded = Identity
+  type StageAnnotation Expanded = Commented SourceSpan
+
+qualificationPhase :: CompilationPhase Expanded Qualified
+qualificationPhase =
+  pureCompilationPhase $
+    fmap snd
+      . subCompile (GlobalState mempty mempty mempty)
+      . advanceStage (LocalState mempty)
+
+deriving instance AdvanceStage CurrentStage ObjTypeBody
+
+deriving instance AdvanceStage CurrentStage DeferredRegisterBody
+
+deriving instance AdvanceStage CurrentStage RegisterBody
+
+deriving instance AdvanceStage CurrentStage AnonymousBitsType
+
+deriving instance AdvanceStage CurrentStage ImportStatement
+
+deriving instance AdvanceStage CurrentStage BitType
+
+deriving instance AdvanceStage CurrentStage EnumBody
+
+deriving instance AdvanceStage CurrentStage EnumConstantDecl
+
+deriving instance AdvanceStage CurrentStage RegisterBitsDecl
+
+deriving instance AdvanceStage CurrentStage PackageBody
+
+deriving instance AdvanceStage CurrentStage ObjTypeDecl
+
+deriving instance AdvanceStage CurrentStage FiddleDecl
+
+deriving instance AdvanceStage CurrentStage FiddleUnit
+
+deriving instance AdvanceStage CurrentStage Expression
+
+deriving instance AdvanceStage CurrentStage RegisterBitsTypeRef
+
+deriving instance AdvanceStage CurrentStage ObjType
+
+deriving instance (AdvanceStage CurrentStage t) => AdvanceStage CurrentStage (Directed t)
diff --git a/src/Main.hs b/src/Main.hs
index 393fb69..fb2a1f2 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -13,6 +13,7 @@ import Language.Fiddle.Compiler
 import Language.Fiddle.Compiler.ConsistencyCheck
 import Language.Fiddle.Compiler.Expansion
 import Language.Fiddle.Compiler.ImportResolution
+import Language.Fiddle.Compiler.Qualification
 import Language.Fiddle.Compiler.Stage0
 import Language.Fiddle.GenericTree
   ( GenericSyntaxTree (..),
@@ -29,7 +30,10 @@ import System.IO
 
 -- compilationPipeline :: _ -> _ -> CompilationPhase Parsed Checked
 compilationPipeline parse compile =
-  importResolutionPhase parse compile >>> expansionPhase >>> consistencyCheckPhase
+  importResolutionPhase parse compile
+    >>> expansionPhase
+    >>> qualificationPhase
+    >>> consistencyCheckPhase
 
 -- | Global flags for the compiler.
 newtype GlobalFlags = GlobalFlags