Add import resolution phase and also add a more abstractions around

compliation phases.

1 files changed, 35 insertions, 27 deletions

diff --git a/src/Language/Fiddle/Compiler/Expansion.hs b/src/Language/Fiddle/Compiler/Expansion.hs
index 8cfd0f0..77ccf6c 100644
--- a/src/Language/Fiddle/Compiler/Expansion.hs
+++ b/src/Language/Fiddle/Compiler/Expansion.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE IncoherentInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Language.Fiddle.Compiler.Expansion (expandAst) where
+module Language.Fiddle.Compiler.Expansion (expandAst, expansionPhase) where
 
 import Control.Monad.Identity (Identity (..))
 import Control.Monad.State (get, gets, modify, put)
@@ -18,23 +18,29 @@ import Debug.Trace
 import GHC.TypeLits
 import Language.Fiddle.Ast
 import Language.Fiddle.Compiler
+import Language.Fiddle.Compiler.ConsistencyCheck
 import Language.Fiddle.Types
 import Text.Printf (printf)
 
+type M = Compile State
+
 type Annot = Commented SourceSpan
 
+type CurrentStage = ImportsResolved
+
 newtype Path = Path [PathExpression]
 
 newtype PathExpression = PathExpression String
 
-type M = Compile State
-
 joinPath :: Path -> String
 joinPath (Path l) = intercalate "#" $ reverse (map (\(PathExpression s) -> s) l)
 
-expandAst :: FiddleUnit Parsed I Annot -> Compile () (FiddleUnit Expanded I Annot)
+expandAst :: FiddleUnit CurrentStage I Annot -> Compile () (FiddleUnit Expanded I Annot)
 expandAst = fmap snd . subCompile (State [] []) . advanceStage (Path mempty)
 
+expansionPhase :: CompilationPhase CurrentStage Expanded
+expansionPhase = CompilationPhase (const $ return ()) (\() -> expandAst)
+
 -- Shorthand for Identity
 type I = Identity
 
@@ -47,41 +53,43 @@ data State
       -- Anonymous enum bodies that need to be re-linked
       ![(Linkage, AnonymousBitsType Expanded I Annot)]
 
-instance CompilationStage Parsed where
-  type StageAfter Parsed = Expanded
-  type StageMonad Parsed = M
-  type StageState Parsed = Path
-  type StageFunctor Parsed = Identity
-  type StageAnnotation Parsed = Annot
+instance CompilationStage CurrentStage where
+  type StageAfter CurrentStage = Expanded
+  type StageMonad CurrentStage = M
+  type StageState CurrentStage = Path
+  type StageFunctor CurrentStage = Identity
+  type StageAnnotation CurrentStage = Annot
+
+deriving instance AdvanceStage CurrentStage ObjTypeBody
 
-deriving instance AdvanceStage Parsed ObjTypeBody
+deriving instance AdvanceStage CurrentStage DeferredRegisterBody
 
-deriving instance AdvanceStage Parsed DeferredRegisterBody
+deriving instance AdvanceStage CurrentStage RegisterBody
 
-deriving instance AdvanceStage Parsed RegisterBody
+deriving instance AdvanceStage CurrentStage AnonymousBitsType
 
-deriving instance AdvanceStage Parsed AnonymousBitsType
+deriving instance AdvanceStage CurrentStage ImportStatement
 
-deriving instance AdvanceStage Parsed BitType
+deriving instance AdvanceStage CurrentStage BitType
 
-deriving instance AdvanceStage Parsed EnumBody
+deriving instance AdvanceStage CurrentStage EnumBody
 
-deriving instance AdvanceStage Parsed EnumConstantDecl
+deriving instance AdvanceStage CurrentStage EnumConstantDecl
 
-deriving instance (AdvanceStage Parsed t) => AdvanceStage Parsed (Directed t)
+deriving instance (AdvanceStage CurrentStage t) => AdvanceStage CurrentStage (Directed t)
 
-instance AdvanceStage Parsed RegisterBitsDecl where
+instance AdvanceStage CurrentStage RegisterBitsDecl where
   modifyState t =
     return
       . case t of
         DefinedBits {definedBitsIdent = i} -> pushId i
         _ -> id
 
-instance AdvanceStage Parsed PackageBody where
+instance AdvanceStage CurrentStage PackageBody where
   advanceStage p (PackageBody decls a) =
     PackageBody <$> reconfigureFiddleDecls p decls <*> pure a
 
-instance AdvanceStage Parsed ObjTypeDecl where
+instance AdvanceStage CurrentStage ObjTypeDecl where
   modifyState t =
     return
       . case t of
@@ -89,7 +97,7 @@ instance AdvanceStage Parsed ObjTypeDecl where
         RegisterDecl {regIdent = (Just n)} -> pushId n
         _ -> id
 
-instance AdvanceStage Parsed FiddleDecl where
+instance AdvanceStage CurrentStage FiddleDecl where
   modifyState t =
     return
       . case t of
@@ -99,16 +107,16 @@ instance AdvanceStage Parsed FiddleDecl where
         ObjectDecl {objectIdent = i} -> pushId i
         _ -> id
 
-instance AdvanceStage Parsed FiddleUnit where
+instance AdvanceStage CurrentStage FiddleUnit where
   advanceStage path (FiddleUnit decls a) =
     FiddleUnit <$> reconfigureFiddleDecls path decls <*> pure a
 
-instance AdvanceStage Parsed Expression where
+instance AdvanceStage CurrentStage Expression where
   advanceStage _ = \case
     (Var i a) -> return $ Var i a
     (LitNum t a) -> LitNum <$> parseNum (unCommented a) t <*> pure a
 
-instance AdvanceStage Parsed RegisterBitsTypeRef where
+instance AdvanceStage CurrentStage RegisterBitsTypeRef where
   advanceStage path = \case
     RegisterBitsArray typeref expr annot ->
       RegisterBitsArray
@@ -127,7 +135,7 @@ instance AdvanceStage Parsed RegisterBitsTypeRef where
           =<< advanceStage path anonType
       return $ RegisterBitsReference (identToName ident) annot
 
-instance AdvanceStage Parsed ObjType where
+instance AdvanceStage CurrentStage ObjType where
   advanceStage path = \case
     (AnonymousObjType _ (Identity body) annot) -> do
       body' <- advanceStage path body
@@ -176,7 +184,7 @@ parseNum span txt = fromMayberOrFail span "Unable to parse number" $
 
 reconfigureFiddleDecls ::
   Path ->
-  [Directed FiddleDecl Parsed I Annot] ->
+  [Directed FiddleDecl CurrentStage I Annot] ->
   M [Directed FiddleDecl Expanded I Annot]
 reconfigureFiddleDecls p decls = do
   lastState <- get