-- | 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.
module Language.Fiddle.Compiler.Qualification (qualificationPhase) where

import Control.Monad (forM)
import Control.Monad.Identity
import Data.Foldable (foldlM)
import Data.Maybe (catMaybes)
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 ObjTypeDecl

deriving instance AdvanceStage CurrentStage Expression

instance AdvanceStage CurrentStage RegisterBitsTypeRef where
  advanceStage = undefined

instance AdvanceStage CurrentStage ObjType where
  advanceStage = undefined

deriving instance (AdvanceStage CurrentStage t) => AdvanceStage CurrentStage (Directed t)

instance AdvanceStage CurrentStage PackageBody where
  advanceStage localState (PackageBody decls annot) =
    PackageBody <$> advanceFiddleDecls localState decls <*> pure annot

instance AdvanceStage CurrentStage FiddleUnit where
  advanceStage localState (FiddleUnit () decls annot) =
    FiddleUnit () <$> advanceFiddleDecls localState decls <*> pure annot

advanceFiddleDecls ::
  LocalState ->
  [TreeType (Directed FiddleDecl) CurrentStage] ->
  (StageMonad CurrentStage)
    [TreeType (Directed FiddleDecl) Qualified]
advanceFiddleDecls (LocalState scopePath) decls = fmap (reverse . fst) $ do
  foldlM
    ( \(declsRet, scopePath') -> \case
        Directed {directedSubtree = UsingDecl {usingName = name}} ->
          return (declsRet, addUsingPath (nameToList name) scopePath')
    )
    ([], scopePath)
    decls