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.

1 files changed, 32 insertions, 32 deletions

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