Construction.hs

module HsBindgen.Frontend.Analysis.DeclUseGraph.Construction (
    -- * Construction
    construct
  , insertDepsOfDecl
    -- * Deletion
  , deleteDeps
  , deleteRevDeps
  ) where

import Data.Digraph (Digraph)
import Data.Digraph qualified as Digraph
import Data.List qualified as List
import Data.Set qualified as Set

import Clang.HighLevel.Types

import HsBindgen.Errors
import HsBindgen.Frontend.Analysis
import HsBindgen.Frontend.Analysis.DeclIndex (DeclIndex)
import HsBindgen.Frontend.Analysis.DeclIndex qualified as DeclIndex
import HsBindgen.Frontend.Analysis.DeclUseGraph.Definition
import HsBindgen.Frontend.Analysis.Deps
import HsBindgen.Frontend.Analysis.IncludeGraph (IncludeGraph)
import HsBindgen.Frontend.Analysis.IncludeGraph qualified as IncludeGraph
import HsBindgen.Frontend.Pass.ConstructTranslationUnit.IsPass
import HsBindgen.Frontend.Pass.ReparseMacroExpansions.IsPass
import HsBindgen.Imports
import HsBindgen.IR.C qualified as C

{-------------------------------------------------------------------------------
  Construction
-------------------------------------------------------------------------------}

construct ::
     forall l. HasCallStack
  => IncludeGraph
  -> DeclIndex l
  -> DeclUseGraph
construct includeGraph declIndex = declUseGraph
  where
    -- The include graph informs us about the order of declarations which is
    -- key.
    order :: IncludeGraph.IncludeOrder
    order = IncludeGraph.toIncludeOrder includeGraph
    -- The declaration index contains declarations that we cannot use. Macros
    -- have already been resolved while constructing the declaration index.
    successfulDecls, sortedSuccessfulDecls :: [C.Decl l ConstructTranslationUnit]
    successfulDecls       = DeclIndex.getDecls declIndex
    sortedSuccessfulDecls = List.sortOn (annSortKey order) successfulDecls

    allDeclIds, successfulDeclIds, failedDeclIds :: Set C.DeclId
    allDeclIds        = DeclIndex.keysSet declIndex
    successfulDeclIds = Set.fromList $ map (.info.id) sortedSuccessfulDecls
    failedDeclIds     = allDeclIds Set.\\ successfulDeclIds

    declUseGraph :: DeclUseGraph
    declUseGraph = DeclUseGraph $
      foldl'
        (flip insertDepsOfDeclParsedMacro)
        verticesGraph
        sortedSuccessfulDecls

    -- We first insert all declarations, so that they are assigned vertices. For
    -- successfully parsed declarations, we do this in source order. This
    -- ensures that we preserve source order as much as possible in 'toDecls'
    -- (modulo dependencies).
    verticesGraph :: Digraph Dependency C.DeclId
    verticesGraph = foldl' (flip Digraph.insertVertex) Digraph.empty $
      map (.info.id) sortedSuccessfulDecls ++ Set.toList failedDeclIds

    -- We cannot use plain 'depsOfDecl' here because, at this pass, macros have
    -- been resolved (in the declaration index) but not yet typechecked. We
    -- therefore use 'depsOfDeclParsedMacro', which derives the dependencies
    -- from the resolved (but not yet typechecked) macro body.
    insertDepsOfDeclParsedMacro ::
         C.Decl l ConstructTranslationUnit
      -> Digraph Dependency C.DeclId
      -> Digraph Dependency C.DeclId
    insertDepsOfDeclParsedMacro decl =
      insertDeps decl.info.id (depsOfDeclParsedMacro decl.kind)

insertDeps ::
     (HasCallStack)
  => C.DeclId
  -> [(C.DeclId, Dependency)]
  -> Digraph Dependency C.DeclId
  -> Digraph Dependency C.DeclId
insertDeps source = flip (foldl' aux)
  where
    aux ::
         Digraph Dependency C.DeclId
      -> (C.DeclId, Dependency)
      -> Digraph Dependency C.DeclId
    aux graph (target, edge) =
      case Digraph.insertEdgeIfVerticesExist target edge source graph of
        Digraph.InsertEdgeSuccess graph' -> graph'
        Digraph.InsertEdgeSourceVertexNotFound declId ->
          panicPure $ "source declaration ID not in graph: " ++ show declId
        Digraph.InsertEdgeTargetVertexNotFound declId ->
          panicPure $ "target declaration ID not in graph: " ++ show declId

-- | Inserts dependency edges of provided declaration.
insertDepsOfDecl ::
     HasCallStack
  => C.Decl l ReparseMacroExpansions
  -> DeclUseGraph
  -> DeclUseGraph
insertDepsOfDecl decl declUseGraph = DeclUseGraph $
    insertDeps (decl.info.id) (depsOfDecl decl.kind) declUseGraph.graph

{-------------------------------------------------------------------------------
  Deletion
-------------------------------------------------------------------------------}

-- | Delete edges to the specified vertices, representing dependencies
--
-- This function is used when a type is opaqued, in which case the type no
-- longer has dependencies.
deleteDeps :: Set C.DeclId -> DeclUseGraph -> DeclUseGraph
deleteDeps depIds declUseGraph = DeclUseGraph{
      graph = Digraph.deleteEdgesTo depIds declUseGraph.graph
    }

-- | Delete edges from the specified vertices, representing uses
--
-- This function is used when a type is replaced with an external reference, in
-- which case all uses of the type no longer directly depend on the type.
deleteRevDeps :: Set C.DeclId -> DeclUseGraph -> DeclUseGraph
deleteRevDeps depIds declUseGraph = DeclUseGraph{
      graph = Digraph.deleteEdgesFrom depIds declUseGraph.graph
    }

{-------------------------------------------------------------------------------
  Auxiliary
-------------------------------------------------------------------------------}

data SortKey = SortKey{
      sortPathIx :: IncludeGraph.IncludeOrderIx
    , sortLineNo :: Int
    , sortColNo  :: Int
    }
  deriving (Eq, Ord, Show)

annSortKey :: HasCallStack => IncludeGraph.IncludeOrder -> C.Decl l p -> SortKey
annSortKey order decl = SortKey{
      sortPathIx = sortPathIx
    , sortLineNo = singleLocLine   decl.info.loc
    , sortColNo  = singleLocColumn decl.info.loc
    }
  where
    path = singleLocPath decl.info.loc
    -- Unlike a trace message, a declaration whose source is not in the include
    -- graph means the frontend is broken; there is nothing to salvage.
    sortPathIx = case IncludeGraph.lookupIncludeOrder order path of
      IncludeGraph.NotInIncludeGraph ->
        panicPure $ "Source of declaration " <> show path <> " not in include graph"
      ix -> ix