{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
{-# LANGUAGE TupleSections     #-}
module Tokstyle.Linter.Callgraph (descr) where

import           Control.Applicative         ((<|>))
import           Control.Monad               (forM_, unless)
import qualified Control.Monad.State.Strict  as State
import qualified Data.Array                  as Array
import           Data.Fix                    (foldFix)
import           Data.Foldable               (fold)
import           Data.Graph                  (SCC (..))
import qualified Data.Graph                  as Graph
import           Data.Map.Strict             (Map)
import qualified Data.Map.Strict             as Map
import           Data.Maybe                  (maybeToList)
import qualified Data.Maybe                  as Maybe
import           Data.Set                    (Set, (\\))
import qualified Data.Set                    as Set
import           Data.String                 (IsString (..))
import           Data.Text                   (Text)
import qualified Data.Text                   as Text
import           Language.Cimple             (AlexPosn (..), Lexeme (..),
                                              LexemeClass (..),
                                              LiteralType (..), Node,
                                              NodeF (..), lexemeText)
import           Language.Cimple.Diagnostics (Diagnostics, warn)


data NameKind
    = NKVal
    | NKType
    | NKTypedef
    deriving (NameKind -> NameKind -> Bool
(NameKind -> NameKind -> Bool)
-> (NameKind -> NameKind -> Bool) -> Eq NameKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameKind -> NameKind -> Bool
$c/= :: NameKind -> NameKind -> Bool
== :: NameKind -> NameKind -> Bool
$c== :: NameKind -> NameKind -> Bool
Eq, Eq NameKind
Eq NameKind
-> (NameKind -> NameKind -> Ordering)
-> (NameKind -> NameKind -> Bool)
-> (NameKind -> NameKind -> Bool)
-> (NameKind -> NameKind -> Bool)
-> (NameKind -> NameKind -> Bool)
-> (NameKind -> NameKind -> NameKind)
-> (NameKind -> NameKind -> NameKind)
-> Ord NameKind
NameKind -> NameKind -> Bool
NameKind -> NameKind -> Ordering
NameKind -> NameKind -> NameKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NameKind -> NameKind -> NameKind
$cmin :: NameKind -> NameKind -> NameKind
max :: NameKind -> NameKind -> NameKind
$cmax :: NameKind -> NameKind -> NameKind
>= :: NameKind -> NameKind -> Bool
$c>= :: NameKind -> NameKind -> Bool
> :: NameKind -> NameKind -> Bool
$c> :: NameKind -> NameKind -> Bool
<= :: NameKind -> NameKind -> Bool
$c<= :: NameKind -> NameKind -> Bool
< :: NameKind -> NameKind -> Bool
$c< :: NameKind -> NameKind -> Bool
compare :: NameKind -> NameKind -> Ordering
$ccompare :: NameKind -> NameKind -> Ordering
$cp1Ord :: Eq NameKind
Ord, Int -> NameKind -> ShowS
[NameKind] -> ShowS
NameKind -> String
(Int -> NameKind -> ShowS)
-> (NameKind -> String) -> ([NameKind] -> ShowS) -> Show NameKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameKind] -> ShowS
$cshowList :: [NameKind] -> ShowS
show :: NameKind -> String
$cshow :: NameKind -> String
showsPrec :: Int -> NameKind -> ShowS
$cshowsPrec :: Int -> NameKind -> ShowS
Show)

data Name a = Name
    { Name a -> NameKind
nameKind   :: NameKind
    , Name a -> String
nameFile   :: FilePath
    , Name a -> Lexeme a
nameLexeme :: Lexeme a
    }
    deriving (Int -> Name a -> ShowS
[Name a] -> ShowS
Name a -> String
(Int -> Name a -> ShowS)
-> (Name a -> String) -> ([Name a] -> ShowS) -> Show (Name a)
forall a. Show a => Int -> Name a -> ShowS
forall a. Show a => [Name a] -> ShowS
forall a. Show a => Name a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name a] -> ShowS
$cshowList :: forall a. Show a => [Name a] -> ShowS
show :: Name a -> String
$cshow :: forall a. Show a => Name a -> String
showsPrec :: Int -> Name a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Name a -> ShowS
Show, a -> Name b -> Name a
(a -> b) -> Name a -> Name b
(forall a b. (a -> b) -> Name a -> Name b)
-> (forall a b. a -> Name b -> Name a) -> Functor Name
forall a b. a -> Name b -> Name a
forall a b. (a -> b) -> Name a -> Name b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Name b -> Name a
$c<$ :: forall a b. a -> Name b -> Name a
fmap :: (a -> b) -> Name a -> Name b
$cfmap :: forall a b. (a -> b) -> Name a -> Name b
Functor)

nameKindStr :: Name a -> Text
nameKindStr :: Name a -> Text
nameKindStr = NameKind -> Text
forall p. IsString p => NameKind -> p
str (NameKind -> Text) -> (Name a -> NameKind) -> Name a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name a -> NameKind
forall a. Name a -> NameKind
nameKind
  where
    str :: NameKind -> p
str NameKind
NKVal     = p
"function/constant"
    str NameKind
NKType    = p
"type name"
    str NameKind
NKTypedef = p
"typedef name"

instance Ord a => Ord (Name a) where
    (Name NameKind
ka String
_ Lexeme a
a) <= :: Name a -> Name a -> Bool
<= (Name NameKind
kb String
_ Lexeme a
b) = (NameKind
ka, Lexeme a -> a
forall text. Lexeme text -> text
lexemeText Lexeme a
a) (NameKind, a) -> (NameKind, a) -> Bool
forall a. Ord a => a -> a -> Bool
<= (NameKind
kb, Lexeme a -> a
forall text. Lexeme text -> text
lexemeText Lexeme a
b)

instance Eq a => Eq (Name a) where
    (Name NameKind
ka String
_ Lexeme a
a) == :: Name a -> Name a -> Bool
== (Name NameKind
kb String
_ Lexeme a
b) = NameKind
ka NameKind -> NameKind -> Bool
forall a. Eq a => a -> a -> Bool
== NameKind
kb Bool -> Bool -> Bool
&& Lexeme a -> a
forall text. Lexeme text -> text
lexemeText Lexeme a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Lexeme a -> a
forall text. Lexeme text -> text
lexemeText Lexeme a
b

instance IsString a => IsString (Name a) where
    fromString :: String -> Name a
fromString String
x = NameKind -> String -> Lexeme a -> Name a
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKVal String
"<builtins>" (AlexPosn -> LexemeClass -> a -> Lexeme a
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
L (Int -> Int -> Int -> AlexPosn
AlexPn Int
0 Int
0 Int
0) LexemeClass
IdVar (String -> a
forall a. IsString a => String -> a
fromString String
x))

nktype :: Text -> Name Text
nktype :: Text -> Name Text
nktype = NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKType String
"<builtins>" (Lexeme Text -> Name Text)
-> (Text -> Lexeme Text) -> Text -> Name Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlexPosn -> LexemeClass -> Text -> Lexeme Text
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
L (Int -> Int -> Int -> AlexPosn
AlexPn Int
0 Int
0 Int
0) LexemeClass
IdVar

globalName :: Name Text
globalName :: Name Text
globalName = Name Text
"<global>"

nameText :: Name a -> a
nameText :: Name a -> a
nameText = Lexeme a -> a
forall text. Lexeme text -> text
lexemeText (Lexeme a -> a) -> (Name a -> Lexeme a) -> Name a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name a -> Lexeme a
forall a. Name a -> Lexeme a
nameLexeme


type Callgraph = Map (Name Text) (Set (Name Text))

getSrcName :: (Name Text, Name Text, [Name Text]) -> Name Text
getSrcName :: (Name Text, Name Text, [Name Text]) -> Name Text
getSrcName (Name Text
node, Name Text
_, [Name Text]
_) = Name Text
node

cgToEdges :: Callgraph -> [(Name Text, Name Text, [Name Text])]
cgToEdges :: Callgraph -> [(Name Text, Name Text, [Name Text])]
cgToEdges = ((Name Text, Set (Name Text))
 -> (Name Text, Name Text, [Name Text]))
-> [(Name Text, Set (Name Text))]
-> [(Name Text, Name Text, [Name Text])]
forall a b. (a -> b) -> [a] -> [b]
map (Name Text, Set (Name Text)) -> (Name Text, Name Text, [Name Text])
forall b a. (b, Set a) -> (b, b, [a])
toEdges ([(Name Text, Set (Name Text))]
 -> [(Name Text, Name Text, [Name Text])])
-> (Callgraph -> [(Name Text, Set (Name Text))])
-> Callgraph
-> [(Name Text, Name Text, [Name Text])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Callgraph -> [(Name Text, Set (Name Text))]
forall k a. Map k a -> [(k, a)]
Map.assocs
  where toEdges :: (b, Set a) -> (b, b, [a])
toEdges (b
src, Set a
dsts) = (b
src, b
src, Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
dsts)


data Env = Env
    { Env -> Set (Name Text)
outgoing :: Set (Name Text)
    , Env -> Set (Name Text)
locals   :: Set (Name Text)
    , Env -> Maybe (Name Text)
envFunc  :: Maybe (Name Text)
    , Env -> Callgraph
funcs    :: Callgraph
    }
    deriving (Int -> Env -> ShowS
[Env] -> ShowS
Env -> String
(Int -> Env -> ShowS)
-> (Env -> String) -> ([Env] -> ShowS) -> Show Env
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Env] -> ShowS
$cshowList :: [Env] -> ShowS
show :: Env -> String
$cshow :: Env -> String
showsPrec :: Int -> Env -> ShowS
$cshowsPrec :: Int -> Env -> ShowS
Show)

instance Semigroup Env where
    Env
a <> :: Env -> Env -> Env
<> Env
b = Env :: Set (Name Text)
-> Set (Name Text) -> Maybe (Name Text) -> Callgraph -> Env
Env
        { outgoing :: Set (Name Text)
outgoing = Set (Name Text) -> Set (Name Text) -> Set (Name Text)
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Env -> Set (Name Text)
outgoing Env
a) (Env -> Set (Name Text)
outgoing Env
b)
        , locals :: Set (Name Text)
locals = Set (Name Text) -> Set (Name Text) -> Set (Name Text)
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Env -> Set (Name Text)
locals Env
a) (Env -> Set (Name Text)
locals Env
b)
        , envFunc :: Maybe (Name Text)
envFunc = Env -> Maybe (Name Text)
envFunc Env
a Maybe (Name Text) -> Maybe (Name Text) -> Maybe (Name Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Env -> Maybe (Name Text)
envFunc Env
b
        , funcs :: Callgraph
funcs = (Set (Name Text) -> Set (Name Text) -> Set (Name Text))
-> Callgraph -> Callgraph -> Callgraph
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set (Name Text) -> Set (Name Text) -> Set (Name Text)
forall a. Semigroup a => a -> a -> a
(<>) (Env -> Callgraph
funcs Env
a) (Env -> Callgraph
funcs Env
b)
        }

instance Monoid Env where
    mempty :: Env
mempty = Env
empty

empty :: Env
empty :: Env
empty = Env :: Set (Name Text)
-> Set (Name Text) -> Maybe (Name Text) -> Callgraph -> Env
Env
    { outgoing :: Set (Name Text)
outgoing = Set (Name Text)
forall a. Set a
Set.empty
    , locals :: Set (Name Text)
locals   = Set (Name Text)
forall a. Set a
Set.empty
    , envFunc :: Maybe (Name Text)
envFunc  = Maybe (Name Text)
forall a. Maybe a
Nothing
    , funcs :: Callgraph
funcs    = Callgraph
forall k a. Map k a
Map.empty
    }


callgraph :: [(FilePath, [Node (Lexeme Text)])] -> Callgraph
callgraph :: [(String, [Node (Lexeme Text)])] -> Callgraph
callgraph = Env -> Callgraph
funcs (Env -> Callgraph)
-> ([(String, [Node (Lexeme Text)])] -> Env)
-> [(String, [Node (Lexeme Text)])]
-> Callgraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Env] -> Env
forall a. Monoid a => [a] -> a
mconcat ([Env] -> Env)
-> ([(String, [Node (Lexeme Text)])] -> [Env])
-> [(String, [Node (Lexeme Text)])]
-> Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [Node (Lexeme Text)]) -> [Env])
-> [(String, [Node (Lexeme Text)])] -> [Env]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> [Node (Lexeme Text)] -> [Env])
-> (String, [Node (Lexeme Text)]) -> [Env]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((String -> [Node (Lexeme Text)] -> [Env])
 -> (String, [Node (Lexeme Text)]) -> [Env])
-> (String -> [Node (Lexeme Text)] -> [Env])
-> (String, [Node (Lexeme Text)])
-> [Env]
forall a b. (a -> b) -> a -> b
$ (Node (Lexeme Text) -> Env) -> [Node (Lexeme Text)] -> [Env]
forall a b. (a -> b) -> [a] -> [b]
map ((Node (Lexeme Text) -> Env) -> [Node (Lexeme Text)] -> [Env])
-> (String -> Node (Lexeme Text) -> Env)
-> String
-> [Node (Lexeme Text)]
-> [Env]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeF (Lexeme Text) Env -> Env) -> Node (Lexeme Text) -> Env
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix ((NodeF (Lexeme Text) Env -> Env) -> Node (Lexeme Text) -> Env)
-> (String -> NodeF (Lexeme Text) Env -> Env)
-> String
-> Node (Lexeme Text)
-> Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NodeF (Lexeme Text) Env -> Env
go)
  where
    go :: FilePath -> NodeF (Lexeme Text) Env -> Env
    go :: String -> NodeF (Lexeme Text) Env -> Env
go String
file (TyUserDefined Lexeme Text
name) = Env
empty{outgoing :: Set (Name Text)
outgoing = Name Text -> Set (Name Text)
forall a. a -> Set a
Set.singleton (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKType String
file Lexeme Text
name)}
    go String
file (TyStruct Lexeme Text
name) = Env
empty{outgoing :: Set (Name Text)
outgoing = Name Text -> Set (Name Text)
forall a. a -> Set a
Set.singleton (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKType String
file Lexeme Text
name)}

    go String
file (LiteralExpr LiteralType
ConstId Lexeme Text
name) = Env
empty{outgoing :: Set (Name Text)
outgoing = Name Text -> Set (Name Text)
forall a. a -> Set a
Set.singleton (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKVal String
file Lexeme Text
name)}
    go String
file (VarExpr Lexeme Text
name) = Env
empty{outgoing :: Set (Name Text)
outgoing = Name Text -> Set (Name Text)
forall a. a -> Set a
Set.singleton (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKVal String
file Lexeme Text
name)}

    go String
file (MacroParam Lexeme Text
name) = Env
empty{locals :: Set (Name Text)
locals = Name Text -> Set (Name Text)
forall a. a -> Set a
Set.singleton (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKVal String
file Lexeme Text
name)}
    go String
file (VarDecl Env
ty Lexeme Text
name [Env]
arrs) = (Env -> Env -> Env) -> Env -> [Env] -> Env
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Env -> Env -> Env
forall a. Semigroup a => a -> a -> a
(<>) Env
empty{locals :: Set (Name Text)
locals = Name Text -> Set (Name Text)
forall a. a -> Set a
Set.singleton (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKVal String
file Lexeme Text
name)} (Env
tyEnv -> [Env] -> [Env]
forall a. a -> [a] -> [a]
:[Env]
arrs)
    go String
file (VLA Env
_ Lexeme Text
name Env
size) = Env
empty{locals :: Set (Name Text)
locals = Name Text -> Set (Name Text)
forall a. a -> Set a
Set.singleton (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKVal String
file Lexeme Text
name)} Env -> Env -> Env
forall a. Semigroup a => a -> a -> a
<> Env
size

    go String
file (FunctionPrototype Env
_ Lexeme Text
name [Env]
params) = (Env -> Env -> Env) -> Env -> [Env] -> Env
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Env -> Env -> Env
forall a. Semigroup a => a -> a -> a
(<>) Env
empty{envFunc :: Maybe (Name Text)
envFunc = Name Text -> Maybe (Name Text)
forall a. a -> Maybe a
Just (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKVal String
file Lexeme Text
name)} [Env]
params

    go String
file (PreprocDefineConst Lexeme Text
name Env
env) = Env
empty{funcs :: Callgraph
funcs = Name Text -> Set (Name Text) -> Callgraph
forall k a. k -> a -> Map k a
Map.singleton (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKVal String
file Lexeme Text
name) (Env -> Set (Name Text)
outgoing Env
env)}
    go String
file (ConstDefn Scope
_ Env
_      Lexeme Text
name Env
env) = Env
empty{funcs :: Callgraph
funcs = Name Text -> Set (Name Text) -> Callgraph
forall k a. k -> a -> Map k a
Map.singleton (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKVal String
file Lexeme Text
name) (Env -> Set (Name Text)
outgoing Env
env)}
    go String
file (Enumerator         Lexeme Text
name Maybe Env
env) = Env
empty{funcs :: Callgraph
funcs = Name Text -> Set (Name Text) -> Callgraph
forall k a. k -> a -> Map k a
Map.singleton (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKVal String
file Lexeme Text
name) (Set (Name Text)
-> (Env -> Set (Name Text)) -> Maybe Env -> Set (Name Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set (Name Text)
forall a. Set a
Set.empty Env -> Set (Name Text)
outgoing Maybe Env
env)}
--  TODO(iphydf): Fix static_assert.
--  go _    (StaticAssert          env _) = empty{funcs = Map.singleton globalName (outgoing env)}
    go String
_    (StaticAssert            Env
_ Lexeme Text
_) = Env
empty

    go String
file (PreprocDefineMacro Lexeme Text
func [Env]
params Env
body) =
        let Env{Set (Name Text)
outgoing :: Set (Name Text)
outgoing :: Env -> Set (Name Text)
outgoing, Set (Name Text)
locals :: Set (Name Text)
locals :: Env -> Set (Name Text)
locals} = [Env] -> Env
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Env]
params Env -> Env -> Env
forall a. Semigroup a => a -> a -> a
<> Env
body in
        Env
empty{funcs :: Callgraph
funcs = Name Text -> Set (Name Text) -> Callgraph
forall k a. k -> a -> Map k a
Map.singleton (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKVal String
file Lexeme Text
func) (Set (Name Text) -> Set (Name Text) -> Set (Name Text)
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set (Name Text)
outgoing Set (Name Text)
locals)}
    go String
_ (FunctionDefn Scope
_ Env
proto Env
body) =
        let
           Env{Set (Name Text)
outgoing :: Set (Name Text)
outgoing :: Env -> Set (Name Text)
outgoing, Set (Name Text)
locals :: Set (Name Text)
locals :: Env -> Set (Name Text)
locals, Maybe (Name Text)
envFunc :: Maybe (Name Text)
envFunc :: Env -> Maybe (Name Text)
envFunc, Callgraph
funcs :: Callgraph
funcs :: Env -> Callgraph
funcs} = Env
proto Env -> Env -> Env
forall a. Semigroup a => a -> a -> a
<> Env
body
           func :: Name Text
func = Name Text -> Maybe (Name Text) -> Name Text
forall a. a -> Maybe a -> a
Maybe.fromMaybe Name Text
globalName Maybe (Name Text)
envFunc
        in
        Env
empty{funcs :: Callgraph
funcs = Name Text -> Set (Name Text) -> Callgraph -> Callgraph
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name Text
func (Set (Name Text)
outgoing Set (Name Text) -> Set (Name Text) -> Set (Name Text)
forall a. Ord a => Set a -> Set a -> Set a
\\ Set (Name Text)
locals Set (Name Text) -> Set (Name Text) -> Set (Name Text)
forall a. Ord a => Set a -> Set a -> Set a
\\ Callgraph -> Set (Name Text)
forall k a. Map k a -> Set k
Map.keysSet Callgraph
funcs) (Callgraph -> Callgraph) -> Callgraph -> Callgraph
forall a b. (a -> b) -> a -> b
$ (Name Text -> Name Text) -> Callgraph -> Callgraph
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys ((Text -> Text) -> Name Text -> Name Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
k -> Name Text -> Text
forall a. Name a -> a
nameText Name Text
func Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"::" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k)) Callgraph
funcs}

    go String
file (Union  Lexeme Text
name [Env]
envs) = Env
empty{funcs :: Callgraph
funcs = Name Text -> Set (Name Text) -> Callgraph
forall k a. k -> a -> Map k a
Map.singleton (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKType String
file Lexeme Text
name) (Env -> Set (Name Text)
outgoing (Env -> Set (Name Text)) -> Env -> Set (Name Text)
forall a b. (a -> b) -> a -> b
$ [Env] -> Env
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Env]
envs)}
    go String
file (Struct Lexeme Text
name [Env]
envs) = Env
empty{funcs :: Callgraph
funcs = Name Text -> Set (Name Text) -> Callgraph
forall k a. k -> a -> Map k a
Map.singleton (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKType String
file Lexeme Text
name) (Env -> Set (Name Text)
outgoing (Env -> Set (Name Text)) -> Env -> Set (Name Text)
forall a b. (a -> b) -> a -> b
$ [Env] -> Env
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Env]
envs)}
    go String
file (EnumDecl Lexeme Text
_ [Env]
envs Lexeme Text
name) =
        let Env{Set (Name Text)
outgoing :: Set (Name Text)
outgoing :: Env -> Set (Name Text)
outgoing, Callgraph
funcs :: Callgraph
funcs :: Env -> Callgraph
funcs} = [Env] -> Env
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Env]
envs in
        Env
empty{funcs :: Callgraph
funcs = Name Text -> Set (Name Text) -> Callgraph -> Callgraph
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKType String
file Lexeme Text
name) Set (Name Text)
outgoing Callgraph
funcs}
    go String
file (Typedef Env
env Lexeme Text
name) =
        let Env{Set (Name Text)
outgoing :: Set (Name Text)
outgoing :: Env -> Set (Name Text)
outgoing, Callgraph
funcs :: Callgraph
funcs :: Env -> Callgraph
funcs} = Env
env in
        Env
env{funcs :: Callgraph
funcs = Name Text -> Set (Name Text) -> Callgraph -> Callgraph
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (NameKind -> String -> Lexeme Text -> Name Text
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKTypedef String
file Lexeme Text
name) Set (Name Text)
outgoing Callgraph
funcs}

    go String
_ FunctionDecl    {} = Env
empty
    go String
_ TypedefFunction {} = Env
empty

    go String
_ (PreprocIf     Env
_ [Env]
t Env
e) = [Env] -> Env
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Env] -> Env) -> [Env] -> Env
forall a b. (a -> b) -> a -> b
$ Env
eEnv -> [Env] -> [Env]
forall a. a -> [a] -> [a]
:[Env]
t
    go String
_ (PreprocIfdef  Lexeme Text
_ [Env]
t Env
e) = [Env] -> Env
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Env] -> Env) -> [Env] -> Env
forall a b. (a -> b) -> a -> b
$ Env
eEnv -> [Env] -> [Env]
forall a. a -> [a] -> [a]
:[Env]
t
    go String
_ (PreprocIfndef Lexeme Text
_ [Env]
t Env
e) = [Env] -> Env
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Env] -> Env) -> [Env] -> Env
forall a b. (a -> b) -> a -> b
$ Env
eEnv -> [Env] -> [Env]
forall a. a -> [a] -> [a]
:[Env]
t
    go String
_ (PreprocElif   Env
_ [Env]
t Env
e) = [Env] -> Env
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Env] -> Env) -> [Env] -> Env
forall a b. (a -> b) -> a -> b
$ Env
eEnv -> [Env] -> [Env]
forall a. a -> [a] -> [a]
:[Env]
t

    go String
_ NodeF (Lexeme Text) Env
n = NodeF (Lexeme Text) Env -> Env
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold NodeF (Lexeme Text) Env
n


checkReferences :: Callgraph -> Diagnostics ()
checkReferences :: Callgraph -> Diagnostics ()
checkReferences Callgraph
cg =
    [(Name Text, Set (Name Text))]
-> ((Name Text, Set (Name Text)) -> Diagnostics ())
-> Diagnostics ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Callgraph -> [(Name Text, Set (Name Text))]
forall k a. Map k a -> [(k, a)]
Map.assocs Callgraph
cg) (((Name Text, Set (Name Text)) -> Diagnostics ())
 -> Diagnostics ())
-> ((Name Text, Set (Name Text)) -> Diagnostics ())
-> Diagnostics ()
forall a b. (a -> b) -> a -> b
$ \(Name Text
src, Set (Name Text)
dsts) ->
        (Name Text -> Diagnostics ()) -> Set (Name Text) -> Diagnostics ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Name Text -> Name Text -> Diagnostics ()
forall diags.
HasDiagnostics diags =>
Name Text -> Name Text -> StateT diags Identity ()
checkForward Name Text
src) Set (Name Text)
dsts
  where
    dests :: Name a -> [Name a]
dests name :: Name a
name@(Name NameKind
k String
f Lexeme a
n) = Name a
name Name a -> [Name a] -> [Name a]
forall a. a -> [a] -> [a]
: Maybe (Name a) -> [Name a]
forall a. Maybe a -> [a]
maybeToList (
        case NameKind
k of
            NameKind
NKType    -> Name a -> Maybe (Name a)
forall a. a -> Maybe a
Just (NameKind -> String -> Lexeme a -> Name a
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKTypedef String
f Lexeme a
n)
            NameKind
NKTypedef -> Name a -> Maybe (Name a)
forall a. a -> Maybe a
Just (NameKind -> String -> Lexeme a -> Name a
forall a. NameKind -> String -> Lexeme a -> Name a
Name NameKind
NKType String
f Lexeme a
n)
            NameKind
NKVal     -> Maybe (Name a)
forall a. Maybe a
Nothing)
    checkForward :: Name Text -> Name Text -> StateT diags Identity ()
checkForward Name Text
src Name Text
dst =
        Bool -> StateT diags Identity () -> StateT diags Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Name Text -> Bool) -> [Name Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Name Text -> Callgraph -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Callgraph
cg) ([Name Text] -> Bool) -> [Name Text] -> Bool
forall a b. (a -> b) -> a -> b
$ Name Text -> [Name Text]
forall a. Name a -> [Name a]
dests Name Text
dst) (StateT diags Identity () -> StateT diags Identity ())
-> StateT diags Identity () -> StateT diags Identity ()
forall a b. (a -> b) -> a -> b
$
            String -> Lexeme Text -> Text -> StateT diags Identity ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
String -> at -> Text -> DiagnosticsT diags ()
warn (Name Text -> String
forall a. Name a -> String
nameFile Name Text
dst) (Name Text -> Lexeme Text
forall a. Name a -> Lexeme a
nameLexeme Name Text
dst) (Text -> StateT diags Identity ())
-> Text -> StateT diags Identity ()
forall a b. (a -> b) -> a -> b
$ Text
"definition of `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name Text -> Text
forall a. Name a -> a
nameText Name Text
src
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` references undefined global " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name Text -> Text
forall a. Name a -> Text
nameKindStr Name Text
dst
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name Text -> Text
forall a. Name a -> a
nameText Name Text
dst Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"


checkCycles :: Callgraph -> Diagnostics ()
checkCycles :: Callgraph -> Diagnostics ()
checkCycles Callgraph
cg =
    [SCC (Name Text, Name Text, [Name Text])]
-> (SCC (Name Text, Name Text, [Name Text]) -> Diagnostics ())
-> Diagnostics ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(Name Text, Name Text, [Name Text])]
-> [SCC (Name Text, Name Text, [Name Text])]
forall key node.
Ord key =>
[(node, key, [key])] -> [SCC (node, key, [key])]
Graph.stronglyConnCompR [(Name Text, Name Text, [Name Text])]
edgeList) ((SCC (Name Text, Name Text, [Name Text]) -> Diagnostics ())
 -> Diagnostics ())
-> (SCC (Name Text, Name Text, [Name Text]) -> Diagnostics ())
-> Diagnostics ()
forall a b. (a -> b) -> a -> b
$ \case
        AcyclicSCC{} -> () -> Diagnostics ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        CyclicSCC [] -> () -> Diagnostics ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        CyclicSCC vs :: [(Name Text, Name Text, [Name Text])]
vs@((Name Text
src, Name Text
_, [Name Text]
_):[(Name Text, Name Text, [Name Text])]
_) ->
            let funcs :: [Text]
funcs = ((Name Text, Name Text, [Name Text]) -> Text)
-> [(Name Text, Name Text, [Name Text])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Name Text -> Text
forall a. Name a -> a
nameText (Name Text -> Text)
-> ((Name Text, Name Text, [Name Text]) -> Name Text)
-> (Name Text, Name Text, [Name Text])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name Text, Name Text, [Name Text]) -> Name Text
getSrcName) [(Name Text, Name Text, [Name Text])]
vs in
            Bool -> Diagnostics () -> Diagnostics ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text] -> Bool
forall a. (Eq a, IsString a) => [a] -> Bool
cycleIsOK [Text]
funcs) (Diagnostics () -> Diagnostics ())
-> Diagnostics () -> Diagnostics ()
forall a b. (a -> b) -> a -> b
$ Name Text -> [Text] -> Diagnostics ()
forall diags a.
(HasDiagnostics diags, Show a) =>
Name Text -> [a] -> StateT diags Identity ()
warnCycle Name Text
src [Text]
funcs

  where
    edgeList :: [(Name Text, Name Text, [Name Text])]
edgeList = Callgraph -> [(Name Text, Name Text, [Name Text])]
cgToEdges Callgraph
cg

    cycleIsOK :: [a] -> Bool
cycleIsOK [a
"add_to_closest"] = Bool
True
    cycleIsOK [a
"add_to_list"] = Bool
True
    cycleIsOK [a
"dht_pk_callback",a
"change_dht_pk",a
"dht_ip_callback",a
"friend_new_connection"] = Bool
True
    cycleIsOK [a
"add_conn_to_groupchat",a
"g_handle_packet",a
"handle_message_packet_group",a
"freeze_peer"
              ,a
"try_send_rejoin",a
"handle_packet_rejoin",a
"g_handle_status",a
"set_conns_status_groups"
              ,a
"set_conns_type_connections",a
"check_disconnected"] = Bool
True
    cycleIsOK [a]
_ = Bool
False

    warnCycle :: Name Text -> [a] -> StateT diags Identity ()
warnCycle (Name NameKind
NKType String
_ Lexeme Text
_) [a]
_ = () -> StateT diags Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    warnCycle Name Text
src [a
_] = String -> Lexeme Text -> Text -> StateT diags Identity ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
String -> at -> Text -> DiagnosticsT diags ()
warn (Name Text -> String
forall a. Name a -> String
nameFile Name Text
src) (Name Text -> Lexeme Text
forall a. Name a -> Lexeme a
nameLexeme Name Text
src) (Text -> StateT diags Identity ())
-> Text -> StateT diags Identity ()
forall a b. (a -> b) -> a -> b
$
        Text
"function `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name Text -> Text
forall a. Name a -> a
nameText Name Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` is recursive; prefer loops instead"
    warnCycle Name Text
src [a]
funcs = String -> Lexeme Text -> Text -> StateT diags Identity ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
String -> at -> Text -> DiagnosticsT diags ()
warn (Name Text -> String
forall a. Name a -> String
nameFile Name Text
src) (Name Text -> Lexeme Text
forall a. Name a -> Lexeme a
nameLexeme Name Text
src) (Text -> StateT diags Identity ())
-> Text -> StateT diags Identity ()
forall a b. (a -> b) -> a -> b
$
        Text
"function `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name Text -> Text
forall a. Name a -> a
nameText Name Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` is part of a cycle: `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack ([a] -> String
forall a. Show a => a -> String
show [a]
funcs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"


checkUnused :: Callgraph -> Diagnostics ()
checkUnused :: Callgraph -> Diagnostics ()
checkUnused Callgraph
cg =
    [Name Text] -> (Name Text -> Diagnostics ()) -> Diagnostics ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Name Text]
roots ((Name Text -> Diagnostics ()) -> Diagnostics ())
-> (Name Text -> Diagnostics ()) -> Diagnostics ()
forall a b. (a -> b) -> a -> b
$ \case
        Name NameKind
NKType String
_ Lexeme Text
_ -> () -> Diagnostics ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Name NameKind
NKTypedef String
_ Lexeme Text
_ -> () -> Diagnostics ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Name Text
src -> String -> Lexeme Text -> Text -> Diagnostics ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
String -> at -> Text -> DiagnosticsT diags ()
warn (Name Text -> String
forall a. Name a -> String
nameFile Name Text
src) (Name Text -> Lexeme Text
forall a. Name a -> Lexeme a
nameLexeme Name Text
src) (Text -> Diagnostics ()) -> Text -> Diagnostics ()
forall a b. (a -> b) -> a -> b
$ Text
"unused symbol `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name Text -> Text
forall a. Name a -> a
nameText Name Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
  where
    (Graph
graph, Int -> (Name Text, Name Text, [Name Text])
nodeFromVertex, Name Text -> Maybe Int
_) = [(Name Text, Name Text, [Name Text])]
-> (Graph, Int -> (Name Text, Name Text, [Name Text]),
    Name Text -> Maybe Int)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
Graph.graphFromEdges ([(Name Text, Name Text, [Name Text])]
 -> (Graph, Int -> (Name Text, Name Text, [Name Text]),
     Name Text -> Maybe Int))
-> (Callgraph -> [(Name Text, Name Text, [Name Text])])
-> Callgraph
-> (Graph, Int -> (Name Text, Name Text, [Name Text]),
    Name Text -> Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Callgraph -> [(Name Text, Name Text, [Name Text])]
cgToEdges (Callgraph
 -> (Graph, Int -> (Name Text, Name Text, [Name Text]),
     Name Text -> Maybe Int))
-> Callgraph
-> (Graph, Int -> (Name Text, Name Text, [Name Text]),
    Name Text -> Maybe Int)
forall a b. (a -> b) -> a -> b
$ Callgraph
cg

    roots :: [Name Text]
roots =
        (Name Text -> Bool) -> [Name Text] -> [Name Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Name Text -> Bool) -> Name Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. (Eq a, IsString a) => a -> Bool
isExemptFile (String -> Bool) -> (Name Text -> String) -> Name Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name Text -> String
forall a. Name a -> String
nameFile)
        ([Name Text] -> [Name Text])
-> (Graph -> [Name Text]) -> Graph -> [Name Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name Text -> Bool) -> [Name Text] -> [Name Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Name Text -> Bool) -> Name Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
isExempt (Text -> Bool) -> (Name Text -> Text) -> Name Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name Text -> Text
forall a. Name a -> a
nameText)
        ([Name Text] -> [Name Text])
-> (Graph -> [Name Text]) -> Graph -> [Name Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Name Text) -> [(Int, Int)] -> [Name Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Name Text, Name Text, [Name Text]) -> Name Text
getSrcName ((Name Text, Name Text, [Name Text]) -> Name Text)
-> ((Int, Int) -> (Name Text, Name Text, [Name Text]))
-> (Int, Int)
-> Name Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Name Text, Name Text, [Name Text])
nodeFromVertex (Int -> (Name Text, Name Text, [Name Text]))
-> ((Int, Int) -> Int)
-> (Int, Int)
-> (Name Text, Name Text, [Name Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> a
fst)
        ([(Int, Int)] -> [Name Text])
-> (Graph -> [(Int, Int)]) -> Graph -> [Name Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> ((Int, Int) -> Int) -> (Int, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd)
        ([(Int, Int)] -> [(Int, Int)])
-> (Graph -> [(Int, Int)]) -> Graph -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int Int -> [(Int, Int)]
forall i e. Ix i => Array i e -> [(i, e)]
Array.assocs
        (Array Int Int -> [(Int, Int)])
-> (Graph -> Array Int Int) -> Graph -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> Array Int Int
Graph.indegree
        (Graph -> [Name Text]) -> Graph -> [Name Text]
forall a b. (a -> b) -> a -> b
$ Graph
graph

    isExemptFile :: a -> Bool
isExemptFile a
"<builtins>" = Bool
True
    isExemptFile a
_            = Bool
False

    isExempt :: Text -> Bool
isExempt Text
name = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
        [ Text
"bin_pack_" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        , Text
"bin_unpack_" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        , Text
"cmp_" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        , Text
"crypto_auth" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        , Text
"crypto_sign_" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        , Text
"msgpack_" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        , Text
"TOX_" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        , Text
"TOXAV_" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        , Text
"tox_" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        , Text
"toxav_" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        , Text
"max_" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        , Text
"min_" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        , Text
"::" Text -> Text -> Bool
`Text.isInfixOf` Text
name
        , Text
name Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
            [ Text
"<global>"
            , Text
"main"
            -- Feature test macros.
            , Text
"__EXTENSIONS__"
            , Text
"_XOPEN_SOURCE"
            , Text
"_WIN32_WINNT"
            , Text
"WINVER"

            , Text
"NET_PACKET_MAX"  -- TODO(iphydf): Maybe some more general rule about this.
            , Text
"at_shutdown"  -- Actually #if-0'd.

            -- TODO(iphydf): Maybe toxcore should have a bootstrap node API so DHT_bootstrap is
            -- less special.
            , Text
"BOOTSTRAP_INFO_PACKET_ID"
            -- TODO(iphydf): Clean these up.
            , Text
"announce_on_stored"
            , Text
"announce_set_synch_offset"
            , Text
"dht_bootstrap_from_address"
            , Text
"dht_set_self_public_key"
            , Text
"dht_set_self_secret_key"
            , Text
"friend_conn_get_dht_ip_port"
            , Text
"friend_conn_get_onion_friendnum"
            , Text
"gca_pack_announces_list_size"
            , Text
"get_ip6_loopback"
            , Text
"get_random_tcp_conn_ip_port"
            , Text
"ipport_self_copy"
            , Text
"mono_time_set_current_time_callback"
            , Text
"net_addr_get_port"
            , Text
"net_family_is_tcp_onion"
            , Text
"net_family_is_tox_tcp_ipv6"
            , Text
"net_family_tox_tcp_ipv4"
            , Text
"net_family_tox_tcp_ipv6"
            , Text
"onion_announce_entry_public_key"
            , Text
"onion_announce_entry_set_time"
            , Text
"onion_getfriendip"
            , Text
"os_network_deinit"
            , Text
"system_network_deinit"  -- TODO(iphydf): Delete.
            , Text
"rb_data"
            , Text
"rb_full"
            , Text
"sanctions_list_packed_size"
            , Text
"send_announce_request"
            , Text
"send_data_request"
            , Text
"send_forward_request"
            , Text
"send_tcp_forward_request"
            , Text
"set_callback_forwarded_response"
            , Text
"set_forwarding_packet_tcp_connection_callback"
            , Text
"tcp_connections_public_key"
            , Text
"tcp_send_oob_packet_using_relay"
            , Text
"tcp_server_listen_count"

            -- TODO(iphydf): Clean these up.
            , Text
"ARRAY_ENTRY_SIZE"
            , Text
"AUDIO_MAX_BUFFER_SIZE_BYTES"
            , Text
"FILEKIND_AVATAR"
            , Text
"FILEKIND_DATA"
            , Text
"FILE_PAUSE_BOTH"
            , Text
"MAX_TCP_CONNECTIONS"
            , Text
"MAX_TCP_RELAYS_PEER"
            , Text
"MESSAGE_NORMAL"
            , Text
"MSI_E_INVALID_PARAM"
            , Text
"ONION_DATA_FRIEND_REQ"
            , Text
"PACKET_ID_RANGE_LOSSLESS_NORMAL_END"
            , Text
"PACKET_ID_RANGE_LOSSLESS_NORMAL_START"
            , Text
"PACKET_ID_RANGE_LOSSY_CUSTOM_END"
            , Text
"PACKET_ID_RANGE_RESERVED_END"
            , Text
"PACKET_ID_RANGE_RESERVED_START"
            , Text
"SELF_UDP_STATUS_LAN"
            , Text
"TCP_CLIENT_NO_STATUS"
            , Text
"USERSTATUS_AWAY"
            , Text
"USERSTATUS_BUSY"

            -- From cmp.c, maybe clean up?
            , Text
"NEGATIVE_FIXNUM_MARKER"
            , Text
"POSITIVE_FIXNUM_MARKER"
            ]
        ]


linter :: Callgraph -> Diagnostics ()
linter :: Callgraph -> Diagnostics ()
linter Callgraph
cg = do
    Callgraph -> Diagnostics ()
checkReferences Callgraph
cg
    Callgraph -> Diagnostics ()
checkCycles Callgraph
cg
    Callgraph -> Diagnostics ()
checkUnused Callgraph
cg


analyse :: [(FilePath, [Node (Lexeme Text)])] -> [Text]
analyse :: [(String, [Node (Lexeme Text)])] -> [Text]
analyse = [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text])
-> ([(String, [Node (Lexeme Text)])] -> [Text])
-> [(String, [Node (Lexeme Text)])]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Diagnostics () -> [Text] -> [Text])
-> [Text] -> Diagnostics () -> [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Diagnostics () -> [Text] -> [Text]
forall s a. State s a -> s -> s
State.execState [] (Diagnostics () -> [Text])
-> ([(String, [Node (Lexeme Text)])] -> Diagnostics ())
-> [(String, [Node (Lexeme Text)])]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Callgraph -> Diagnostics ()
linter (Callgraph -> Diagnostics ())
-> ([(String, [Node (Lexeme Text)])] -> Callgraph)
-> [(String, [Node (Lexeme Text)])]
-> Diagnostics ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Callgraph
forall a. Map (Name Text) (Set a)
builtins Callgraph -> Callgraph -> Callgraph
forall a. Semigroup a => a -> a -> a
<>) (Callgraph -> Callgraph)
-> ([(String, [Node (Lexeme Text)])] -> Callgraph)
-> [(String, [Node (Lexeme Text)])]
-> Callgraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, [Node (Lexeme Text)])] -> Callgraph
callgraph
  where
    builtins :: Map (Name Text) (Set a)
builtins = [(Name Text, Set a)] -> Map (Name Text) (Set a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name Text, Set a)] -> Map (Name Text) (Set a))
-> ([Name Text] -> [(Name Text, Set a)])
-> [Name Text]
-> Map (Name Text) (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name Text -> (Name Text, Set a))
-> [Name Text] -> [(Name Text, Set a)]
forall a b. (a -> b) -> [a] -> [b]
map (,Set a
forall a. Set a
Set.empty) ([Name Text] -> Map (Name Text) (Set a))
-> [Name Text] -> Map (Name Text) (Set a)
forall a b. (a -> b) -> a -> b
$
        [ Name Text
"AF_INET"
        , Name Text
"AF_INET6"
        , Name Text
"AF_UNSPEC"

        , Name Text
"EBADF"
        , Name Text
"EINPROGRESS"
        , Name Text
"EWOULDBLOCK"

        , Name Text
"WORDS_BIGENDIAN"

        -- cake
        , Name Text
"static_set"

        , Name Text
"crypto_aead_xchacha20poly1305_ietf_decrypt"
        , Name Text
"crypto_aead_xchacha20poly1305_ietf_encrypt"
        , Name Text
"crypto_auth_BYTES"
        , Name Text
"crypto_auth_KEYBYTES"
        , Name Text
"crypto_auth"
        , Name Text
"crypto_auth_hmacsha512"
        , Name Text
"crypto_auth_verify"
        , Name Text
"crypto_box_afternm"
        , Name Text
"crypto_box_beforenm"
        , Name Text
"crypto_box_BEFORENMBYTES"
        , Name Text
"crypto_box_BOXZEROBYTES"
        , Name Text
"crypto_box_keypair"
        , Name Text
"crypto_box_MACBYTES"
        , Name Text
"crypto_box_NONCEBYTES"
        , Name Text
"crypto_box_open_afternm"
        , Name Text
"crypto_box_PUBLICKEYBYTES"
        , Name Text
"crypto_box_SECRETKEYBYTES"
        , Name Text
"crypto_box_ZEROBYTES"
        , Name Text
"crypto_hash_sha256"
        , Name Text
"crypto_hash_sha256_BYTES"
        , Name Text
"crypto_hash_sha512"
        , Name Text
"crypto_hash_sha512_BYTES"
        , Name Text
"crypto_pwhash_scryptsalsa208sha256"
        , Name Text
"crypto_pwhash_scryptsalsa208sha256_MEMLIMIT_INTERACTIVE"
        , Name Text
"crypto_pwhash_scryptsalsa208sha256_OPSLIMIT_INTERACTIVE"
        , Name Text
"crypto_pwhash_scryptsalsa208sha256_SALTBYTES"
        , Name Text
"crypto_scalarmult_curve25519_base"
        , Name Text
"crypto_sign_BYTES"
        , Name Text
"crypto_sign_PUBLICKEYBYTES"
        , Name Text
"crypto_sign_SECRETKEYBYTES"
        , Name Text
"crypto_sign_SEEDBYTES"
        , Name Text
"crypto_sign_detached"
        , Name Text
"crypto_sign_ed25519_pk_to_curve25519"
        , Name Text
"crypto_sign_ed25519_sk_to_curve25519"
        , Name Text
"crypto_sign_keypair"
        , Name Text
"crypto_sign_seed_keypair"
        , Name Text
"crypto_sign_verify_detached"
        , Name Text
"crypto_verify_32"
        , Name Text
"crypto_verify_64"
        , Name Text
"randombytes"
        , Name Text
"randombytes_stir"
        , Name Text
"randombytes_random"
        , Name Text
"randombytes_uniform"
        , Name Text
"sodium_init"
        , Name Text
"sodium_memzero"
        , Name Text
"sodium_mlock"
        , Name Text
"sodium_munlock"

        , Name Text
"EVBREAK_ALL"
        , Name Text
"EV_READ"
        , Name Text
"ev_async"
        , Name Text
"ev_async_init"
        , Name Text
"ev_async_send"
        , Name Text
"ev_async_start"
        , Name Text
"ev_async_stop"
        , Name Text
"ev_break"
        , Name Text
"ev_init"
        , Name Text
"ev_io"
        , Name Text
"ev_io_init"
        , Name Text
"ev_io_start"
        , Name Text
"ev_io_stop"
        , Name Text
"ev_is_active"
        , Name Text
"ev_is_pending"
        , Name Text
"ev_loop"
        , Name Text
"ev_loop_destroy"
        , Name Text
"ev_loop_new"
        , Name Text
"ev_run"

        , Name Text
"NULL"
        , Name Text
"SIZEOF_VLA"
        , Name Text
"abort"
        , Name Text
"assert"
        , Name Text
"calloc"
        , Name Text
"errno"
        , Name Text
"fprintf"
        , Name Text
"fputc"
        , Name Text
"free"
        , Name Text
"malloc"
        , Name Text
"memcmp"
        , Name Text
"memcpy"
        , Name Text
"memmove"
        , Name Text
"memset"
        , Name Text
"nullptr"
        , Name Text
"qsort"
        , Name Text
"realloc"
        , Name Text
"snprintf"
        , Name Text
"stderr"
        , Name Text
"stdout"
        , Name Text
"strerror_r"
        , Name Text
"strlen"
        , Name Text
"strrchr"
        , Name Text
"strstr"
        , Name Text
"time"
        , Name Text
"va_end"
        , Name Text
"va_start"
        , Name Text
"vsnprintf"

        , Name Text
"ERROR_BUFFER_OVERFLOW"
        , Name Text
"NO_ERROR"
        , Name Text
"WSAAddressToString"
        , Name Text
"WSACleanup"
        , Name Text
"WSAECONNRESET"
        , Name Text
"WSAEINPROGRESS"
        , Name Text
"WSAEWOULDBLOCK"
        , Name Text
"WSAGetLastError"
        , Name Text
"WSAStartup"
        , Name Text
"WSAStringToAddress"

        , Name Text
"CLOCK_MONOTONIC"
        , Name Text
"clock_get_time"
        , Name Text
"clock_gettime"
        , Text -> Name Text
nktype Text
"timespec"

        , Name Text
"F_SETFL"
        , Name Text
"FD_SET"
        , Name Text
"FD_ZERO"
        , Name Text
"FIONBIO"
        , Name Text
"FIONREAD"
        , Name Text
"INADDR_BROADCAST"
        , Name Text
"INET_ADDRSTRLEN"
        , Name Text
"INET6_ADDRSTRLEN"
        , Name Text
"IPPROTO_IPV6"
        , Name Text
"IPPROTO_TCP"
        , Name Text
"IPPROTO_UDP"
        , Name Text
"IPV6_JOIN_GROUP"
        , Name Text
"O_NONBLOCK"
        , Name Text
"SIOCGIFBRDADDR"
        , Name Text
"SIOCGIFCONF"
        , Name Text
"SOCK_DGRAM"
        , Name Text
"SOCK_STREAM"
        , Name Text
"SOL_SOCKET"
        , Name Text
"SO_BROADCAST"
        , Name Text
"SO_EXCLUSIVEADDRUSE"
        , Name Text
"SO_NOSIGPIPE"
        , Name Text
"SO_RCVBUF"
        , Name Text
"SO_REUSEADDR"
        , Name Text
"SO_SNDBUF"
        , Name Text
"accept"
        , Name Text
"bind"
        , Name Text
"close"
        , Name Text
"closesocket"
        , Name Text
"connect"
        , Name Text
"fcntl"
        , Name Text
"fd_set"
        , Name Text
"freeaddrinfo"
        , Name Text
"getaddrinfo"
        , Name Text
"getsockopt"
        , Name Text
"htonl"
        , Name Text
"htons"
        , Name Text
"in6addr_loopback"
        , Name Text
"inet_ntop"
        , Name Text
"inet_pton"
        , Name Text
"ioctl"
        , Name Text
"ioctlsocket"
        , Name Text
"listen"
        , Name Text
"ntohl"
        , Name Text
"ntohs"
        , Name Text
"recv"
        , Name Text
"recvfrom"
        , Name Text
"select"
        , Name Text
"send"
        , Name Text
"sendto"
        , Name Text
"setsockopt"
        , Name Text
"socket"
        , Text -> Name Text
nktype Text
"addrinfo"
        , Text -> Name Text
nktype Text
"ifconf"
        , Text -> Name Text
nktype Text
"ifreq"
        , Text -> Name Text
nktype Text
"in_addr"
        , Text -> Name Text
nktype Text
"in6_addr"
        , Text -> Name Text
nktype Text
"ipv6_mreq"
        , Text -> Name Text
nktype Text
"sockaddr"
        , Text -> Name Text
nktype Text
"sockaddr_in"
        , Text -> Name Text
nktype Text
"sockaddr_in6"
        , Text -> Name Text
nktype Text
"sockaddr_storage"
        , Text -> Name Text
nktype Text
"timeval"

        , Name Text
"EPOLL_CTL_ADD"
        , Name Text
"EPOLL_CTL_MOD"
        , Name Text
"EPOLLERR"
        , Name Text
"EPOLLET"
        , Name Text
"EPOLLHUP"
        , Name Text
"EPOLLIN"
        , Name Text
"epoll_create"
        , Name Text
"epoll_ctl"
        , Name Text
"epoll_wait"
        , Text -> Name Text
nktype Text
"epoll_event"

        , Name Text
"__FILE__"
        , Name Text
"__LINE__"
        , Name Text
"__VA_ARGS__"
        , Name Text
"__func__"

        , Name Text
"FORMAT_MESSAGE_ALLOCATE_BUFFER"
        , Name Text
"FORMAT_MESSAGE_FROM_SYSTEM"
        , Name Text
"FORMAT_MESSAGE_IGNORE_INSERTS"
        , Name Text
"MAKEWORD"
        , Name Text
"FormatMessageA"
        , Name Text
"GetAdaptersInfo"
        , Name Text
"GetTickCount"
        , Name Text
"LocalFree"
        , Name Text
"QueryPerformanceCounter"
        , Name Text
"QueryPerformanceFrequency"

        , Name Text
"SYSTEM_CLOCK"
        , Name Text
"host_get_clock_service"
        , Name Text
"mach_host_self"
        , Name Text
"mach_port_deallocate"
        , Name Text
"mach_task_self"

        , Name Text
"at_startup_ran"

        , Name Text
"TOX_VERSION_IS_API_COMPATIBLE"
        , Name Text
"tox_options_get_dht_announcements_enabled"
        , Name Text
"tox_options_get_end_port"
        , Name Text
"tox_options_get_experimental_thread_safety"
        , Name Text
"tox_options_get_hole_punching_enabled"
        , Name Text
"tox_options_get_ipv6_enabled"
        , Name Text
"tox_options_get_local_discovery_enabled"
        , Name Text
"tox_options_get_log_callback"
        , Name Text
"tox_options_get_log_user_data"
        , Name Text
"tox_options_get_operating_system"
        , Name Text
"tox_options_get_proxy_host"
        , Name Text
"tox_options_get_proxy_port"
        , Name Text
"tox_options_get_proxy_type"
        , Name Text
"tox_options_get_savedata_length"
        , Name Text
"tox_options_get_savedata_type"
        , Name Text
"tox_options_get_start_port"
        , Name Text
"tox_options_get_tcp_port"
        , Name Text
"tox_options_get_udp_enabled"
        , Name Text
"tox_options_set_dht_announcements_enabled"
        , Name Text
"tox_options_set_experimental_thread_safety"
        , Name Text
"tox_options_set_hole_punching_enabled"
        , Name Text
"tox_options_set_ipv6_enabled"
        , Name Text
"tox_options_set_local_discovery_enabled"
        , Name Text
"tox_options_set_operating_system"
        , Name Text
"tox_options_set_proxy_type"
        , Name Text
"tox_options_set_udp_enabled"

        , Name Text
"PTHREAD_MUTEX_RECURSIVE"
        , Name Text
"pthread_mutexattr_destroy"
        , Name Text
"pthread_mutexattr_init"
        , Name Text
"pthread_mutexattr_settype"
        , Name Text
"pthread_mutex_destroy"
        , Name Text
"pthread_mutex_init"
        , Name Text
"pthread_mutex_lock"
        , Name Text
"pthread_mutex_trylock"
        , Name Text
"pthread_mutex_unlock"
        , Name Text
"pthread_rwlock_destroy"
        , Name Text
"pthread_rwlock_init"
        , Name Text
"pthread_rwlock_rdlock"
        , Name Text
"pthread_rwlock_unlock"
        , Name Text
"pthread_rwlock_wrlock"

        , Name Text
"INT_MAX"
        , Name Text
"INT32_MAX"
        , Name Text
"UINT8_MAX"
        , Name Text
"UINT16_MAX"
        , Name Text
"UINT32_MAX"
        , Name Text
"UINT64_MAX"
        , Name Text
"SIZE_MAX"
        , Name Text
"UINT32_C"
        , Name Text
"INT64_C"
        , Name Text
"UINT64_C"

        , Name Text
"OPUS_APPLICATION_AUDIO"
        , Name Text
"OPUS_APPLICATION_VOIP"
        , Name Text
"OPUS_INVALID_PACKET"
        , Name Text
"OPUS_OK"
        , Name Text
"OPUS_SET_BITRATE"
        , Name Text
"OPUS_SET_COMPLEXITY"
        , Name Text
"OPUS_SET_INBAND_FEC"
        , Name Text
"OPUS_SET_PACKET_LOSS_PERC"
        , Name Text
"OPUS_SET_VBR"
        , Name Text
"opus_packet_get_nb_channels"
        , Name Text
"opus_strerror"
        , Name Text
"opus_decode"
        , Name Text
"opus_decoder_create"
        , Name Text
"opus_decoder_destroy"
        , Name Text
"opus_decoder_get_nb_samples"
        , Name Text
"opus_encode"
        , Name Text
"opus_encoder_create"
        , Name Text
"opus_encoder_ctl"
        , Name Text
"opus_encoder_destroy"
        , Text -> Name Text
nktype Text
"OpusDecoder"
        , Text -> Name Text
nktype Text
"OpusEncoder"

        , Name Text
"VP8_DEBLOCK"
        , Name Text
"VP8_SET_POSTPROC"
        , Name Text
"VP8E_SET_CPUUSED"
        , Name Text
"VP8E_SET_NOISE_SENSITIVITY"
        , Name Text
"VPX_CODEC_CX_FRAME_PKT"
        , Name Text
"VPX_IMG_FMT_I420"
        , Name Text
"VPX_CODEC_INCAPABLE"
        , Name Text
"VPX_CODEC_OK"
        , Name Text
"VPX_CODEC_USE_FRAME_THREADING"
        , Name Text
"VPX_CODEC_USE_POSTPROC"
        , Name Text
"VPX_EFLAG_FORCE_KF"
        , Name Text
"VPX_ERROR_RESILIENT_DEFAULT"
        , Name Text
"VPX_ERROR_RESILIENT_PARTITIONS"
        , Name Text
"VPX_FRAME_IS_KEY"
        , Name Text
"VPX_KF_AUTO"
        , Name Text
"VPX_PLANE_U"
        , Name Text
"VPX_PLANE_V"
        , Name Text
"VPX_PLANE_Y"
        , Name Text
"VPX_RC_ONE_PASS"
        , Name Text
"VPX_VBR"
        , Name Text
"vpx_codec_control"
        , Name Text
"vpx_codec_dec_init"
        , Name Text
"vpx_codec_decode"
        , Name Text
"vpx_codec_destroy"
        , Name Text
"vpx_codec_enc_config_default"
        , Name Text
"vpx_codec_enc_config_set"
        , Name Text
"vpx_codec_enc_init"
        , Name Text
"vpx_codec_encode"
        , Name Text
"vpx_codec_err_to_string"
        , Name Text
"vpx_codec_get_cx_data"
        , Name Text
"vpx_codec_get_frame"
        , Name Text
"vpx_codec_vp8_cx"
        , Name Text
"vpx_codec_vp8_dx"
        , Name Text
"vpx_img_alloc"
        , Name Text
"vpx_img_free"
        ]

descr :: ([(FilePath, [Node (Lexeme Text)])] -> [Text], (Text, Text))
descr :: ([(String, [Node (Lexeme Text)])] -> [Text], (Text, Text))
descr = ([(String, [Node (Lexeme Text)])] -> [Text]
analyse, (Text
"callgraph", [Text] -> Text
Text.unlines
    [ Text
"Performs various call graph related checks:"
    , Text
""
    , Text
"- There should be no unused functions. Even unused `extern` functions are not"
    , Text
"  permitted, except for the exported library interface."
    , Text
"- Only a subset of standard library, POSIX, WinAPI, or Darwin API functions are"
    , Text
"  allowed. Any use of unvetted functions (such as `setjmp`) is not permitted."
    , Text
"- Recursion is not allowed outside of a few exemptions that should be fixed."
    , Text
"  Code should be written to use iteration, instead, possibly with a manually"
    , Text
"  managed stack to keep intermediate results for algorithms like DFS."
    , Text
""
    , Text
"**Reason:**"
    , Text
""
    , Text
"- Unused symbols require useless maintenance."
    , Text
"- We want to keep control over how much of the standard library we use."
    , Text
"- Unbounded recursion can cause stack overflows and makes it impossible to"
    , Text
"  statically determine the maximum stack memory requirements of a program, which"
    , Text
"  is especially useful in embedded software."
    ]))