{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiWayIf            #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TupleSections         #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
module Tokstyle.Linter.Nullability (descr) where

import           Control.Monad                (foldM, forM, forM_, unless, void,
                                               when)
import           Control.Monad.State.Strict   (State)
import qualified Control.Monad.State.Strict   as State
import           Data.Fix                     (Fix (..), unFix)
import           Data.Foldable                (traverse_)
import           Data.List                    (find, zip3)
import           Data.Map.Strict              (Map)
import qualified Data.Map.Strict              as Map
import           Data.Maybe                   (fromMaybe)
import           Data.Set                     (Set)
import qualified Data.Set                     as Set
import           Data.Text                    (Text)
import qualified Data.Text                    as Text
import           Language.Cimple              (AssignOp (..), BinaryOp (..),
                                               Lexeme (..), NodeF (..),
                                               UnaryOp (..))
import qualified Language.Cimple              as C
import           Language.Cimple.Diagnostics  (CimplePos, Diagnostic (..),
                                               DiagnosticLevel (..),
                                               DiagnosticSpan (..),
                                               nodePosAndLen, warnRich)
import           Language.Cimple.Pretty       (ppNode, showNodePlain)
import           Language.Cimple.TraverseAst  (AstActions, astActions, doNode,
                                               traverseAst)
import           Prettyprinter                (parens, pretty, (<+>))
import           Tokstyle.Analysis.AccessPath
import           Tokstyle.Analysis.Dataflow   (Dataflow (..), solve)
import qualified Tokstyle.Analysis.Symbolic   as S
import           Tokstyle.Analysis.Symbolic   (lookupStore, sAddr, sBinOp, sIte,
                                               sUnaryOp, sVar)

import           Tokstyle.Cimple.Analysis.CFG (CFG, EdgeType (..), Node (..),
                                               NodeKind (..), fromFunction,
                                               getFuncName)
import           Tokstyle.Common              (backticks, functionName, warnDoc)

data Nullability
    = NullableVar
    | NonNullVar
    | UnspecifiedNullability
    deriving (Int -> Nullability -> ShowS
[Nullability] -> ShowS
Nullability -> String
(Int -> Nullability -> ShowS)
-> (Nullability -> String)
-> ([Nullability] -> ShowS)
-> Show Nullability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nullability] -> ShowS
$cshowList :: [Nullability] -> ShowS
show :: Nullability -> String
$cshow :: Nullability -> String
showsPrec :: Int -> Nullability -> ShowS
$cshowsPrec :: Int -> Nullability -> ShowS
Show, Nullability -> Nullability -> Bool
(Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Bool) -> Eq Nullability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nullability -> Nullability -> Bool
$c/= :: Nullability -> Nullability -> Bool
== :: Nullability -> Nullability -> Bool
$c== :: Nullability -> Nullability -> Bool
Eq, Eq Nullability
Eq Nullability
-> (Nullability -> Nullability -> Ordering)
-> (Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Nullability)
-> (Nullability -> Nullability -> Nullability)
-> Ord Nullability
Nullability -> Nullability -> Bool
Nullability -> Nullability -> Ordering
Nullability -> Nullability -> Nullability
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 :: Nullability -> Nullability -> Nullability
$cmin :: Nullability -> Nullability -> Nullability
max :: Nullability -> Nullability -> Nullability
$cmax :: Nullability -> Nullability -> Nullability
>= :: Nullability -> Nullability -> Bool
$c>= :: Nullability -> Nullability -> Bool
> :: Nullability -> Nullability -> Bool
$c> :: Nullability -> Nullability -> Bool
<= :: Nullability -> Nullability -> Bool
$c<= :: Nullability -> Nullability -> Bool
< :: Nullability -> Nullability -> Bool
$c< :: Nullability -> Nullability -> Bool
compare :: Nullability -> Nullability -> Ordering
$ccompare :: Nullability -> Nullability -> Ordering
$cp1Ord :: Eq Nullability
Ord)

type VarInfo = (Nullability, Maybe (C.Node (Lexeme Text)))

type TypeEnv = Map Text VarInfo

data LinterState = LinterState
    { LinterState -> TypeEnv
typeEnv        :: TypeEnv
    , LinterState -> Map Text TypeEnv
structDefs     :: Map Text TypeEnv
    , LinterState -> Map Text (Nullability, [(Text, Nullability)])
functionDefs   :: Map Text (Nullability, [(Text, Nullability)])
    , LinterState -> String
currentFile    :: FilePath
    , LinterState -> Nullability
currentFuncRet :: Nullability
    }

type LinterM = State.StateT LinterState (State [Diagnostic CimplePos])

isNullable :: C.Node (Lexeme Text) -> Bool
isNullable :: Node (Lexeme Text) -> Bool
isNullable (Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) = case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
    C.TyNullable Node (Lexeme Text)
_      -> Bool
True
    C.TyPointer Node (Lexeme Text)
t       -> Node (Lexeme Text) -> Bool
isNullable Node (Lexeme Text)
t
    C.TyConst Node (Lexeme Text)
t         -> Node (Lexeme Text) -> Bool
isNullable Node (Lexeme Text)
t
    C.TyForce Node (Lexeme Text)
t         -> Node (Lexeme Text) -> Bool
isNullable Node (Lexeme Text)
t
    C.VarDecl Node (Lexeme Text)
ty Lexeme Text
_ [Node (Lexeme Text)]
specs ->
        if (Node (Lexeme Text) -> Bool) -> [Node (Lexeme Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Node (Lexeme Text) -> Bool
isArraySpec [Node (Lexeme Text)]
specs
        then (Node (Lexeme Text) -> Bool) -> [Node (Lexeme Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Node (Lexeme Text) -> Bool
isNullable [Node (Lexeme Text)]
specs
        else Node (Lexeme Text) -> Bool
isNullable Node (Lexeme Text)
ty
    C.DeclSpecArray Nullability
C.Nullable Maybe (Node (Lexeme Text))
_ -> Bool
True
    NodeF (Lexeme Text) (Node (Lexeme Text))
_                   -> Bool
False

isNonnull :: C.Node (Lexeme Text) -> Bool
isNonnull :: Node (Lexeme Text) -> Bool
isNonnull (Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) = case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
    C.TyNonnull Node (Lexeme Text)
_       -> Bool
True
    C.TyPointer Node (Lexeme Text)
t       -> Node (Lexeme Text) -> Bool
isNonnull Node (Lexeme Text)
t
    C.TyConst Node (Lexeme Text)
t         -> Node (Lexeme Text) -> Bool
isNonnull Node (Lexeme Text)
t
    C.TyForce Node (Lexeme Text)
t         -> Node (Lexeme Text) -> Bool
isNonnull Node (Lexeme Text)
t
    C.VarDecl Node (Lexeme Text)
ty Lexeme Text
_ [Node (Lexeme Text)]
specs ->
        if (Node (Lexeme Text) -> Bool) -> [Node (Lexeme Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Node (Lexeme Text) -> Bool
isArraySpec [Node (Lexeme Text)]
specs
        then (Node (Lexeme Text) -> Bool) -> [Node (Lexeme Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Node (Lexeme Text) -> Bool
isNonnull [Node (Lexeme Text)]
specs
        else Node (Lexeme Text) -> Bool
isNonnull Node (Lexeme Text)
ty
    C.DeclSpecArray Nullability
C.Nonnull Maybe (Node (Lexeme Text))
_ -> Bool
True
    NodeF (Lexeme Text) (Node (Lexeme Text))
_                   -> Bool
False

isPointerType :: C.Node (Lexeme Text) -> Bool
isPointerType :: Node (Lexeme Text) -> Bool
isPointerType (Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) = case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
    C.TyPointer Node (Lexeme Text)
_        -> Bool
True
    C.TyNullable Node (Lexeme Text)
t       -> Node (Lexeme Text) -> Bool
isPointerType Node (Lexeme Text)
t
    C.TyNonnull Node (Lexeme Text)
t        -> Node (Lexeme Text) -> Bool
isPointerType Node (Lexeme Text)
t
    C.TyConst Node (Lexeme Text)
t          -> Node (Lexeme Text) -> Bool
isPointerType Node (Lexeme Text)
t
    C.TyForce Node (Lexeme Text)
t          -> Node (Lexeme Text) -> Bool
isPointerType Node (Lexeme Text)
t
    C.VarDecl Node (Lexeme Text)
ty Lexeme Text
_ [Node (Lexeme Text)]
specs -> Node (Lexeme Text) -> Bool
isPointerType Node (Lexeme Text)
ty Bool -> Bool -> Bool
|| (Node (Lexeme Text) -> Bool) -> [Node (Lexeme Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Node (Lexeme Text) -> Bool
isArraySpec [Node (Lexeme Text)]
specs
    C.TyStd Lexeme Text
_            -> Bool
False
    C.TyStruct Lexeme Text
_         -> Bool
False
    C.TyUnion Lexeme Text
_          -> Bool
False
    C.TyUserDefined Lexeme Text
_    -> Bool
True -- Assume pointers can be hidden in typedefs if we don't know
    C.DeclSpecArray {}   -> Bool
True
    NodeF (Lexeme Text) (Node (Lexeme Text))
_                    -> Bool
False

exprToPath :: C.Node (Lexeme Text) -> Maybe AccessPath
exprToPath :: Node (Lexeme Text) -> Maybe AccessPath
exprToPath (Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) = case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
    C.VarExpr (C.L AlexPosn
_ LexemeClass
_ Text
name) -> AccessPath -> Maybe AccessPath
forall a. a -> Maybe a
Just (AccessPath -> Maybe AccessPath) -> AccessPath -> Maybe AccessPath
forall a b. (a -> b) -> a -> b
$ String -> AccessPath
PathVar (Text -> String
Text.unpack Text
name)
    C.PointerAccess Node (Lexeme Text)
e (C.L AlexPosn
_ LexemeClass
_ Text
member) -> AccessPath -> String -> AccessPath
PathField (AccessPath -> String -> AccessPath)
-> Maybe AccessPath -> Maybe (String -> AccessPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text) -> Maybe AccessPath
exprToPath Node (Lexeme Text)
e Maybe (String -> AccessPath) -> Maybe String -> Maybe AccessPath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
Text.unpack Text
member)
    C.MemberAccess Node (Lexeme Text)
e (C.L AlexPosn
_ LexemeClass
_ Text
member) -> AccessPath -> String -> AccessPath
PathField (AccessPath -> String -> AccessPath)
-> Maybe AccessPath -> Maybe (String -> AccessPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text) -> Maybe AccessPath
exprToPath Node (Lexeme Text)
e Maybe (String -> AccessPath) -> Maybe String -> Maybe AccessPath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
Text.unpack Text
member)
    C.ArrayAccess Node (Lexeme Text)
e Node (Lexeme Text)
idx -> AccessPath -> String -> AccessPath
PathIndex (AccessPath -> String -> AccessPath)
-> Maybe AccessPath -> Maybe (String -> AccessPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text) -> Maybe AccessPath
exprToPath Node (Lexeme Text)
e Maybe (String -> AccessPath) -> Maybe String -> Maybe AccessPath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Text
forall a. Pretty a => Node (Lexeme a) -> Text
showNodePlain Node (Lexeme Text)
idx)
    C.UnaryExpr UnaryOp
C.UopDeref Node (Lexeme Text)
e -> AccessPath -> AccessPath
PathDeref (AccessPath -> AccessPath) -> Maybe AccessPath -> Maybe AccessPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text) -> Maybe AccessPath
exprToPath Node (Lexeme Text)
e
    C.ParenExpr Node (Lexeme Text)
e -> Node (Lexeme Text) -> Maybe AccessPath
exprToPath Node (Lexeme Text)
e
    NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> Maybe AccessPath
forall a. Maybe a
Nothing

getParamTypes :: C.Node (Lexeme Text) -> [(Text, VarInfo)]
getParamTypes :: Node (Lexeme Text) -> [(Text, VarInfo)]
getParamTypes (Fix (C.FunctionPrototype Node (Lexeme Text)
_ Lexeme Text
_ [Node (Lexeme Text)]
params)) = (Node (Lexeme Text) -> [(Text, VarInfo)])
-> [Node (Lexeme Text)] -> [(Text, VarInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Node (Lexeme Text) -> [(Text, VarInfo)]
getVarDecls ([Node (Lexeme Text)] -> [(Text, VarInfo)])
-> [Node (Lexeme Text)] -> [(Text, VarInfo)]
forall a b. (a -> b) -> a -> b
$ [Node (Lexeme Text)]
params
  where
    getVarDecls :: Node (Lexeme Text) -> [(Text, VarInfo)]
getVarDecls decl :: Node (Lexeme Text)
decl@(Fix (C.VarDecl Node (Lexeme Text)
ty (C.L AlexPosn
_ LexemeClass
_ Text
name) [Node (Lexeme Text)]
_)) =
        [(Text
name, (Node (Lexeme Text) -> Nullability
getNullability' Node (Lexeme Text)
ty, Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just Node (Lexeme Text)
decl))]
    getVarDecls Node (Lexeme Text)
_ = []
getParamTypes Node (Lexeme Text)
_ = []

getNullability' :: C.Node (Lexeme Text) -> Nullability
getNullability' :: Node (Lexeme Text) -> Nullability
getNullability' Node (Lexeme Text)
ty
  | Node (Lexeme Text) -> Bool
isNullable Node (Lexeme Text)
ty = Nullability
NullableVar
  | Node (Lexeme Text) -> Bool
isNonnull Node (Lexeme Text)
ty  = Nullability
NonNullVar
  | Bool
otherwise     = Nullability
UnspecifiedNullability

getStructName :: C.Node (Lexeme Text) -> Maybe Text
getStructName :: Node (Lexeme Text) -> Maybe Text
getStructName (Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) = case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
    C.VarDecl Node (Lexeme Text)
ty Lexeme Text
_ [Node (Lexeme Text)]
_               -> Node (Lexeme Text) -> Maybe Text
getStructName Node (Lexeme Text)
ty
    C.TyPointer Node (Lexeme Text)
t                  -> Node (Lexeme Text) -> Maybe Text
getStructName Node (Lexeme Text)
t
    C.TyConst Node (Lexeme Text)
t                    -> Node (Lexeme Text) -> Maybe Text
getStructName Node (Lexeme Text)
t
    C.TyNonnull Node (Lexeme Text)
t                  -> Node (Lexeme Text) -> Maybe Text
getStructName Node (Lexeme Text)
t
    C.TyNullable Node (Lexeme Text)
t                 -> Node (Lexeme Text) -> Maybe Text
getStructName Node (Lexeme Text)
t
    C.TyStruct (C.L AlexPosn
_ LexemeClass
_ Text
name)      -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
    C.TyUserDefined (C.L AlexPosn
_ LexemeClass
_ Text
name) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
    NodeF (Lexeme Text) (Node (Lexeme Text))
_                              -> Maybe Text
forall a. Maybe a
Nothing

getDeclaredNullability :: AccessPath -> LinterState -> Nullability
getDeclaredNullability :: AccessPath -> LinterState -> Nullability
getDeclaredNullability AccessPath
path LinterState
st = Nullability -> Maybe Nullability -> Nullability
forall a. a -> Maybe a -> a
fromMaybe Nullability
UnspecifiedNullability (Maybe Nullability -> Nullability)
-> Maybe Nullability -> Nullability
forall a b. (a -> b) -> a -> b
$ case AccessPath
path of
    PathVar String
var -> VarInfo -> Nullability
forall a b. (a, b) -> a
fst (VarInfo -> Nullability) -> Maybe VarInfo -> Maybe Nullability
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> TypeEnv -> Maybe VarInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> Text
Text.pack String
var) (LinterState -> TypeEnv
typeEnv LinterState
st)
    PathField AccessPath
base String
member -> do
        Node (Lexeme Text)
baseType <- AccessPath -> LinterState -> Maybe (Node (Lexeme Text))
getDeclaredType AccessPath
base LinterState
st
        case Node (Lexeme Text)
baseType of
            Fix (C.VarDecl Node (Lexeme Text)
ty Lexeme Text
_ [Node (Lexeme Text)]
specs) | (Node (Lexeme Text) -> Bool) -> [Node (Lexeme Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Node (Lexeme Text) -> Bool
isArraySpec [Node (Lexeme Text)]
specs ->
                Nullability -> Maybe Nullability
forall (m :: * -> *) a. Monad m => a -> m a
return (Nullability -> Maybe Nullability)
-> Nullability -> Maybe Nullability
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Nullability
getNullability' Node (Lexeme Text)
ty
            Node (Lexeme Text)
baseType' -> do
                Text
structName <- Node (Lexeme Text) -> Maybe Text
getStructName Node (Lexeme Text)
baseType'
                TypeEnv
structDef <- Text -> Map Text TypeEnv -> Maybe TypeEnv
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
structName (LinterState -> Map Text TypeEnv
structDefs LinterState
st)
                VarInfo -> Nullability
forall a b. (a, b) -> a
fst (VarInfo -> Nullability) -> Maybe VarInfo -> Maybe Nullability
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> TypeEnv -> Maybe VarInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> Text
Text.pack String
member) TypeEnv
structDef
    PathIndex AccessPath
base String
_ -> do
        Node (Lexeme Text)
baseType <- AccessPath -> LinterState -> Maybe (Node (Lexeme Text))
getDeclaredType AccessPath
base LinterState
st
        case Node (Lexeme Text)
baseType of
            Fix (C.VarDecl Node (Lexeme Text)
ty Lexeme Text
_ [Node (Lexeme Text)]
_) -> Nullability -> Maybe Nullability
forall (m :: * -> *) a. Monad m => a -> m a
return (Nullability -> Maybe Nullability)
-> Nullability -> Maybe Nullability
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Nullability
getNullability' Node (Lexeme Text)
ty
            Node (Lexeme Text)
_                      -> Maybe Nullability
forall a. Maybe a
Nothing
    AccessPath
_ -> Maybe Nullability
forall a. Maybe a
Nothing

getDeclaredType :: AccessPath -> LinterState -> Maybe (C.Node (Lexeme Text))
getDeclaredType :: AccessPath -> LinterState -> Maybe (Node (Lexeme Text))
getDeclaredType AccessPath
path LinterState
st = case AccessPath
path of
    PathVar String
name -> VarInfo -> Maybe (Node (Lexeme Text))
forall a b. (a, b) -> b
snd (VarInfo -> Maybe (Node (Lexeme Text)))
-> Maybe VarInfo -> Maybe (Node (Lexeme Text))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> TypeEnv -> Maybe VarInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> Text
Text.pack String
name) (LinterState -> TypeEnv
typeEnv LinterState
st)
    PathField AccessPath
base String
member -> do
        Node (Lexeme Text)
baseType <- AccessPath -> LinterState -> Maybe (Node (Lexeme Text))
getDeclaredType AccessPath
base LinterState
st
        case Node (Lexeme Text)
baseType of
            Fix (C.VarDecl Node (Lexeme Text)
ty Lexeme Text
_ [Node (Lexeme Text)]
specs) | (Node (Lexeme Text) -> Bool) -> [Node (Lexeme Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Node (Lexeme Text) -> Bool
isArraySpec [Node (Lexeme Text)]
specs ->
                Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just Node (Lexeme Text)
ty
            Node (Lexeme Text)
baseType' -> do
                Text
structName <- Node (Lexeme Text) -> Maybe Text
getStructName Node (Lexeme Text)
baseType'
                TypeEnv
structDef <- Text -> Map Text TypeEnv -> Maybe TypeEnv
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
structName (LinterState -> Map Text TypeEnv
structDefs LinterState
st)
                VarInfo -> Maybe (Node (Lexeme Text))
forall a b. (a, b) -> b
snd (VarInfo -> Maybe (Node (Lexeme Text)))
-> Maybe VarInfo -> Maybe (Node (Lexeme Text))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> TypeEnv -> Maybe VarInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> Text
Text.pack String
member) TypeEnv
structDef
    PathIndex AccessPath
base String
_ -> do
        Node (Lexeme Text)
baseType <- AccessPath -> LinterState -> Maybe (Node (Lexeme Text))
getDeclaredType AccessPath
base LinterState
st
        case Node (Lexeme Text)
baseType of
            Fix (C.VarDecl Node (Lexeme Text)
ty Lexeme Text
_ [Node (Lexeme Text)]
_) -> Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just Node (Lexeme Text)
ty
            Node (Lexeme Text)
_                      -> Maybe (Node (Lexeme Text))
forall a. Maybe a
Nothing
    AccessPath
_ -> Maybe (Node (Lexeme Text))
forall a. Maybe a
Nothing

isArraySpec :: C.Node (Lexeme Text) -> Bool
isArraySpec :: Node (Lexeme Text) -> Bool
isArraySpec (Fix (C.DeclSpecArray {})) = Bool
True
isArraySpec Node (Lexeme Text)
_                          = Bool
False

evaluate :: C.Node (Lexeme Text) -> S.SState -> S.SVal
evaluate :: Node (Lexeme Text) -> SState -> SVal
evaluate expr :: Node (Lexeme Text)
expr@(Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) SState
st = case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
    C.LiteralExpr LiteralType
C.ConstId (C.L AlexPosn
_ LexemeClass
_ Text
"NULL") -> SVal
S.SNull
    C.LiteralExpr LiteralType
_ (C.L AlexPosn
_ LexemeClass
_ Text
"nullptr")      -> SVal
S.SNull
    C.LiteralExpr LiteralType
C.Int (C.L AlexPosn
_ LexemeClass
_ Text
"0")        -> SVal
S.SNull
    C.LiteralExpr LiteralType
C.String Lexeme Text
_                 -> AccessPath -> SVal
sAddr (String -> AccessPath
PathVar String
"<string>")
    C.UnaryExpr UnaryOp
C.UopAddress Node (Lexeme Text)
e               -> case Node (Lexeme Text) -> Maybe AccessPath
exprToPath Node (Lexeme Text)
e of
        Just AccessPath
p  -> AccessPath -> SVal
sAddr AccessPath
p
        Maybe AccessPath
Nothing -> SVal
S.STop
    C.ParenExpr Node (Lexeme Text)
e                            -> Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
e SState
st
    C.CastExpr Node (Lexeme Text)
_ Node (Lexeme Text)
e                           -> Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
e SState
st
    C.TernaryExpr Node (Lexeme Text)
cond Node (Lexeme Text)
thenBranch Node (Lexeme Text)
elseBranch ->
        let c :: SVal
c = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
cond SState
st
            v1 :: SVal
v1 = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
thenBranch SState
st
            v2 :: SVal
v2 = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
elseBranch SState
st
        in if SVal
v1 SVal -> SVal -> Bool
forall a. Eq a => a -> a -> Bool
== SVal
v2 then SVal
v1 else SVal -> SVal -> SVal -> SVal
sIte SVal
c SVal
v1 SVal
v2
    C.BinaryExpr Node (Lexeme Text)
lhs BinaryOp
op Node (Lexeme Text)
rhs                  ->
        let v1 :: SVal
v1 = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
lhs SState
st
            v2 :: SVal
v2 = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
rhs SState
st
        in BinaryOp -> SVal -> SVal -> SVal
sBinOp BinaryOp
op SVal
v1 SVal
v2
    C.UnaryExpr UnaryOp
op Node (Lexeme Text)
e                         ->
        let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
e SState
st
        in UnaryOp -> SVal -> SVal
sUnaryOp UnaryOp
op SVal
v
    NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> case Node (Lexeme Text) -> Maybe AccessPath
exprToPath Node (Lexeme Text)
expr of
        Just AccessPath
path -> SVal -> Maybe SVal -> SVal
forall a. a -> Maybe a -> a
fromMaybe (AccessPath -> SVal
sVar AccessPath
path) (AccessPath -> SState -> Maybe SVal
lookupStore AccessPath
path SState
st)
        Maybe AccessPath
Nothing   -> SVal
S.STop

nullabilityProblem :: LinterState -> Dataflow Node EdgeType S.SState
nullabilityProblem :: LinterState -> Dataflow Node EdgeType SState
nullabilityProblem LinterState
lst = Dataflow :: forall node edge state.
(node -> state -> state)
-> (node -> edge -> state -> state)
-> (state -> state -> state)
-> state
-> Dataflow node edge state
Dataflow
    { transfer :: Node -> SState -> SState
transfer     = Node -> SState -> SState
transferFunc
    , edgeTransfer :: Node -> EdgeType -> SState -> SState
edgeTransfer = Node -> EdgeType -> SState -> SState
edgeTransferFunc
    , merge :: SState -> SState -> SState
merge        = (SVal -> Bool) -> Maybe SVal -> SState -> SState -> SState
S.merge (LinterState -> SVal -> Bool
isDeclNonNull LinterState
lst) Maybe SVal
forall a. Maybe a
Nothing
    , initial :: SState
initial      = SState
S.emptyState
    }
  where
    transferFunc :: Node -> SState -> SState
transferFunc (Node Int
_ NodeKind
nk) SState
s = case NodeKind
nk of
        StmtNode Node (Lexeme Text)
stmt -> Node (Lexeme Text) -> SState -> SState
transferStmt Node (Lexeme Text)
stmt SState
s
        NodeKind
_             -> SState
s

    transferStmt :: Node (Lexeme Text) -> SState -> SState
transferStmt (Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) SState
s = case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
        C.ExprStmt Node (Lexeme Text)
e -> Node (Lexeme Text) -> SState -> SState
transferStmt Node (Lexeme Text)
e SState
s
        C.VarDeclStmt (Fix (C.VarDecl Node (Lexeme Text)
ty (C.L AlexPosn
_ LexemeClass
_ Text
name) [Node (Lexeme Text)]
_)) (Just Node (Lexeme Text)
i) ->
            let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
i SState
s
                path :: AccessPath
path = String -> AccessPath
PathVar (Text -> String
Text.unpack Text
name)
            in if Node (Lexeme Text) -> Bool
isPointerType Node (Lexeme Text)
ty then AccessPath -> SVal -> SState -> SState
S.assign AccessPath
path SVal
v SState
s else SState
s
        C.VarDeclStmt (Fix (C.VarDecl Node (Lexeme Text)
_ (C.L AlexPosn
_ LexemeClass
_ Text
name) [Node (Lexeme Text)]
_)) Maybe (Node (Lexeme Text))
Nothing ->
            let path :: AccessPath
path = String -> AccessPath
PathVar (Text -> String
Text.unpack Text
name)
            in AccessPath -> SVal -> SState -> SState
S.assign AccessPath
path (AccessPath -> SVal
sVar AccessPath
path) SState
s
        C.AssignExpr Node (Lexeme Text)
lhs AssignOp
AopEq Node (Lexeme Text)
rhs ->
            let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
rhs SState
s
            in case Node (Lexeme Text) -> Maybe AccessPath
exprToPath Node (Lexeme Text)
lhs of
                Just AccessPath
path -> AccessPath -> SVal -> SState -> SState
S.assign AccessPath
path SVal
v SState
s
                Maybe AccessPath
Nothing   -> SState
s
        C.FunctionCall Node (Lexeme Text)
funcExpr [Node (Lexeme Text)]
args ->
            let s' :: SState
s' = (SState -> Node (Lexeme Text) -> SState)
-> SState -> [Node (Lexeme Text)] -> SState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Node (Lexeme Text) -> SState -> SState)
-> SState -> Node (Lexeme Text) -> SState
forall a b c. (a -> b -> c) -> b -> a -> c
flip Node (Lexeme Text) -> SState -> SState
transferStmt) SState
s (Node (Lexeme Text)
funcExpr Node (Lexeme Text) -> [Node (Lexeme Text)] -> [Node (Lexeme Text)]
forall a. a -> [a] -> [a]
: [Node (Lexeme Text)]
args)
            in case Node (Lexeme Text) -> Maybe Text
getFuncName Node (Lexeme Text)
funcExpr of
                Just Text
"assert" -> case [Node (Lexeme Text)]
args of
                    [Node (Lexeme Text)
arg] -> Constraint -> SState -> SState
S.addConstraint (SVal -> Constraint
S.SBool (Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
arg SState
s')) SState
s'
                    [Node (Lexeme Text)]
_     -> SState
s'
                Just Text
"LOGGER_ASSERT" -> case [Node (Lexeme Text)]
args of
                    (Node (Lexeme Text)
_:Node (Lexeme Text)
arg:[Node (Lexeme Text)]
_) -> Constraint -> SState -> SState
S.addConstraint (SVal -> Constraint
S.SBool (Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
arg SState
s')) SState
s'
                    [Node (Lexeme Text)]
_         -> SState
s'
                Maybe Text
_ -> SState
s'
        NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> (SState -> Node (Lexeme Text) -> SState)
-> SState -> NodeF (Lexeme Text) (Node (Lexeme Text)) -> SState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Node (Lexeme Text) -> SState -> SState)
-> SState -> Node (Lexeme Text) -> SState
forall a b c. (a -> b -> c) -> b -> a -> c
flip Node (Lexeme Text) -> SState -> SState
transferStmt) SState
s (Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node))

    edgeTransferFunc :: Node -> EdgeType -> SState -> SState
edgeTransferFunc (Node Int
_ (BranchNode Node (Lexeme Text)
cond)) EdgeType
branch SState
s =
        let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
cond SState
s
            constraint :: Constraint
constraint = case EdgeType
branch of
                EdgeType
TrueBranch  -> SVal -> Constraint
S.SBool SVal
v
                EdgeType
FalseBranch -> Constraint -> Constraint
S.negateConstraint (SVal -> Constraint
S.SBool SVal
v)
                EdgeType
_           -> SVal -> SVal -> Constraint
S.SEquals SVal
S.STop SVal
S.STop -- No-op
        in Constraint -> SState -> SState
S.addConstraint Constraint
constraint SState
s
    edgeTransferFunc Node
_ EdgeType
_ SState
s = SState
s

collectTypeEnv :: C.Node (Lexeme Text) -> TypeEnv
collectTypeEnv :: Node (Lexeme Text) -> TypeEnv
collectTypeEnv = (State TypeEnv () -> TypeEnv -> TypeEnv)
-> TypeEnv -> State TypeEnv () -> TypeEnv
forall a b c. (a -> b -> c) -> b -> a -> c
flip State TypeEnv () -> TypeEnv -> TypeEnv
forall s a. State s a -> s -> s
State.execState TypeEnv
forall k a. Map k a
Map.empty (State TypeEnv () -> TypeEnv)
-> (Node (Lexeme Text) -> State TypeEnv ())
-> Node (Lexeme Text)
-> TypeEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (StateT TypeEnv Identity) Text
-> Node (Lexeme Text) -> State TypeEnv ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (StateT TypeEnv Identity) Text
actions
  where
    actions :: AstActions (StateT TypeEnv Identity) Text
actions = AstActions (StateT TypeEnv Identity) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
        { doNode :: String
-> Node (Lexeme Text) -> State TypeEnv () -> State TypeEnv ()
doNode = \String
_ Node (Lexeme Text)
node State TypeEnv ()
act -> case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
            C.VarDecl Node (Lexeme Text)
_ (C.L AlexPosn
_ LexemeClass
_ Text
name) [Node (Lexeme Text)]
_ -> do
                let nullability :: Nullability
nullability = Node (Lexeme Text) -> Nullability
getNullability' Node (Lexeme Text)
node
                (TypeEnv -> TypeEnv) -> State TypeEnv ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((TypeEnv -> TypeEnv) -> State TypeEnv ())
-> (TypeEnv -> TypeEnv) -> State TypeEnv ()
forall a b. (a -> b) -> a -> b
$ Text -> VarInfo -> TypeEnv -> TypeEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name (Nullability
nullability, Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just Node (Lexeme Text)
node)
                State TypeEnv ()
act
            NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> State TypeEnv ()
act
        }

isDeclNonNull :: LinterState -> S.SVal -> Bool
isDeclNonNull :: LinterState -> SVal -> Bool
isDeclNonNull LinterState
lst = \case
    S.SVar AccessPath
path -> AccessPath -> LinterState -> Nullability
getDeclaredNullability AccessPath
path LinterState
lst Nullability -> Nullability -> Bool
forall a. Eq a => a -> a -> Bool
/= Nullability
NullableVar
    S.SAddr AccessPath
_   -> Bool
True
    S.SBinOp BinaryOp
op SVal
v1 SVal
_ | BinaryOp
op BinaryOp -> [BinaryOp] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BinaryOp
BopPlus, BinaryOp
BopMinus] -> LinterState -> SVal -> Bool
isDeclNonNull LinterState
lst SVal
v1
    SVal
_           -> Bool
False

analyseExpr :: S.SState -> C.Node (Lexeme Text) -> LinterM S.SState
analyseExpr :: SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
st expr :: Node (Lexeme Text)
expr@(Fix NodeF (Lexeme Text) (Node (Lexeme Text))
fixNode) = case NodeF (Lexeme Text) (Node (Lexeme Text))
fixNode of
    C.TernaryExpr Node (Lexeme Text)
cond Node (Lexeme Text)
thenBranch Node (Lexeme Text)
elseBranch -> do
        SState
st' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
st Node (Lexeme Text)
cond
        let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
cond SState
st'
        LinterState
lst <- StateT LinterState (State [Diagnostic CimplePos]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        SState
stThen <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr (Constraint -> SState -> SState
S.addConstraint (SVal -> Constraint
S.SBool SVal
v) SState
st') Node (Lexeme Text)
thenBranch
        SState
stElse <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr (Constraint -> SState -> SState
S.addConstraint (Constraint -> Constraint
S.negateConstraint (SVal -> Constraint
S.SBool SVal
v)) SState
st') Node (Lexeme Text)
elseBranch
        SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return (SState -> LinterM SState) -> SState -> LinterM SState
forall a b. (a -> b) -> a -> b
$ (SVal -> Bool) -> Maybe SVal -> SState -> SState -> SState
S.merge (LinterState -> SVal -> Bool
isDeclNonNull LinterState
lst) (SVal -> Maybe SVal
forall a. a -> Maybe a
Just SVal
v) SState
stThen SState
stElse

    C.BinaryExpr Node (Lexeme Text)
lhs BinaryOp
BopAnd Node (Lexeme Text)
rhs -> do
        SState
st' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
st Node (Lexeme Text)
lhs
        let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
lhs SState
st'
        SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr (Constraint -> SState -> SState
S.addConstraint (SVal -> Constraint
S.SBool SVal
v) SState
st') Node (Lexeme Text)
rhs

    C.BinaryExpr Node (Lexeme Text)
lhs BinaryOp
BopOr Node (Lexeme Text)
rhs -> do
        SState
st' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
st Node (Lexeme Text)
lhs
        let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
lhs SState
st'
        SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr (Constraint -> SState -> SState
S.addConstraint (Constraint -> Constraint
S.negateConstraint (SVal -> Constraint
S.SBool SVal
v)) SState
st') Node (Lexeme Text)
rhs

    C.CastExpr Node (Lexeme Text)
toType Node (Lexeme Text)
fromExpr -> do
        SState
st' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
st Node (Lexeme Text)
fromExpr
        LinterState
lst <- StateT LinterState (State [Diagnostic CimplePos]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
fromExpr SState
st'
        Bool
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Node (Lexeme Text) -> Bool
isNonnull Node (Lexeme Text)
toType Bool -> Bool -> Bool
&& (SVal -> Bool) -> SVal -> SState -> Bool
S.canBeNull (LinterState -> SVal -> Bool
isDeclNonNull LinterState
lst) SVal
v SState
st') (StateT LinterState (State [Diagnostic CimplePos]) ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
             StateT [Diagnostic CimplePos] Identity ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (StateT [Diagnostic CimplePos] Identity ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> StateT [Diagnostic CimplePos] Identity ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Node (Lexeme Text)
-> Doc AnsiStyle
-> StateT [Diagnostic CimplePos] Identity ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
String -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> String
currentFile LinterState
lst) Node (Lexeme Text)
fromExpr (Doc AnsiStyle
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
                 Doc AnsiStyle
"expression" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (Node (Lexeme Text) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Node (Lexeme Text)
fromExpr)
                 Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"is nullable and has not been checked before this cast"
        -- After a non-null cast, assume it's non-null in this branch
        SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return (SState -> LinterM SState) -> SState -> LinterM SState
forall a b. (a -> b) -> a -> b
$ if Node (Lexeme Text) -> Bool
isNonnull Node (Lexeme Text)
toType then Constraint -> SState -> SState
S.addConstraint (SVal -> SVal -> Constraint
S.SNotEquals SVal
v SVal
S.SNull) SState
st' else SState
st'

    C.PointerAccess Node (Lexeme Text)
e Lexeme Text
_ -> do
        SState
st' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
st Node (Lexeme Text)
e
        LinterState
lst <- StateT LinterState (State [Diagnostic CimplePos]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
e SState
st'
        Bool
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((SVal -> Bool) -> SVal -> SState -> Bool
S.canBeNull (LinterState -> SVal -> Bool
isDeclNonNull LinterState
lst) SVal
v SState
st') (StateT LinterState (State [Diagnostic CimplePos]) ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
            StateT [Diagnostic CimplePos] Identity ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (StateT [Diagnostic CimplePos] Identity ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> StateT [Diagnostic CimplePos] Identity ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Node (Lexeme Text)
-> Doc AnsiStyle
-> StateT [Diagnostic CimplePos] Identity ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
String -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> String
currentFile LinterState
lst) Node (Lexeme Text)
e (Doc AnsiStyle
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
                Doc AnsiStyle
"pointer" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (Node (Lexeme Text) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Node (Lexeme Text)
e)
                Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"is nullable and has not been checked before this access"
        -- After access, it must have been non-null
        SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return (SState -> LinterM SState) -> SState -> LinterM SState
forall a b. (a -> b) -> a -> b
$ Constraint -> SState -> SState
S.addConstraint (SVal -> SVal -> Constraint
S.SNotEquals SVal
v SVal
S.SNull) SState
st'

    C.ArrayAccess Node (Lexeme Text)
e Node (Lexeme Text)
_ -> do
        SState
st' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
st Node (Lexeme Text)
e
        LinterState
lst <- StateT LinterState (State [Diagnostic CimplePos]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
e SState
st'
        Bool
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (LinterState -> SVal -> Bool
isDeclNonNull LinterState
lst SVal
v) Bool -> Bool -> Bool
&& (SVal -> Bool) -> SVal -> SState -> Bool
S.canBeNull (LinterState -> SVal -> Bool
isDeclNonNull LinterState
lst) SVal
v SState
st') (StateT LinterState (State [Diagnostic CimplePos]) ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
            StateT [Diagnostic CimplePos] Identity ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (StateT [Diagnostic CimplePos] Identity ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> StateT [Diagnostic CimplePos] Identity ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Node (Lexeme Text)
-> Doc AnsiStyle
-> StateT [Diagnostic CimplePos] Identity ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
String -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> String
currentFile LinterState
lst) Node (Lexeme Text)
e (Doc AnsiStyle
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
                Doc AnsiStyle
"pointer" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (Node (Lexeme Text) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Node (Lexeme Text)
e)
                Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"is nullable and has not been checked before this access"
        SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return (SState -> LinterM SState) -> SState -> LinterM SState
forall a b. (a -> b) -> a -> b
$ Constraint -> SState -> SState
S.addConstraint (SVal -> SVal -> Constraint
S.SNotEquals SVal
v SVal
S.SNull) SState
st'

    C.UnaryExpr UnaryOp
C.UopDeref Node (Lexeme Text)
e -> do
        SState
st' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
st Node (Lexeme Text)
e
        LinterState
lst <- StateT LinterState (State [Diagnostic CimplePos]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
e SState
st'
        Bool
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((SVal -> Bool) -> SVal -> SState -> Bool
S.canBeNull (LinterState -> SVal -> Bool
isDeclNonNull LinterState
lst) SVal
v SState
st') (StateT LinterState (State [Diagnostic CimplePos]) ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
            StateT [Diagnostic CimplePos] Identity ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (StateT [Diagnostic CimplePos] Identity ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> StateT [Diagnostic CimplePos] Identity ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Node (Lexeme Text)
-> Doc AnsiStyle
-> StateT [Diagnostic CimplePos] Identity ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
String -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> String
currentFile LinterState
lst) Node (Lexeme Text)
e (Doc AnsiStyle
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
                Doc AnsiStyle
"pointer" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (Node (Lexeme Text) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Node (Lexeme Text)
e)
                Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"is nullable and has not been checked before this dereference"
        SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return (SState -> LinterM SState) -> SState -> LinterM SState
forall a b. (a -> b) -> a -> b
$ Constraint -> SState -> SState
S.addConstraint (SVal -> SVal -> Constraint
S.SNotEquals SVal
v SVal
S.SNull) SState
st'

    C.FunctionCall Node (Lexeme Text)
funcExpr [Node (Lexeme Text)]
args -> do
        SState
st' <- (SState -> Node (Lexeme Text) -> LinterM SState)
-> SState -> [Node (Lexeme Text)] -> LinterM SState
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
st (Node (Lexeme Text)
funcExpr Node (Lexeme Text) -> [Node (Lexeme Text)] -> [Node (Lexeme Text)]
forall a. a -> [a] -> [a]
: [Node (Lexeme Text)]
args)
        LinterState
lst <- StateT LinterState (State [Diagnostic CimplePos]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        let mFuncInfo :: Maybe (Nullability, [(Text, Nullability)])
mFuncInfo = case Node (Lexeme Text) -> Maybe Text
getFuncName Node (Lexeme Text)
funcExpr of
                Just Text
name -> Text
-> Map Text (Nullability, [(Text, Nullability)])
-> Maybe (Nullability, [(Text, Nullability)])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name (LinterState -> Map Text (Nullability, [(Text, Nullability)])
functionDefs LinterState
lst)
                Maybe Text
Nothing   -> Maybe (Nullability, [(Text, Nullability)])
forall a. Maybe a
Nothing

        let mFuncInfo' :: Maybe (Nullability, [(Text, Nullability)])
mFuncInfo' = case Maybe (Nullability, [(Text, Nullability)])
mFuncInfo of
                Just (Nullability, [(Text, Nullability)])
info -> (Nullability, [(Text, Nullability)])
-> Maybe (Nullability, [(Text, Nullability)])
forall a. a -> Maybe a
Just (Nullability, [(Text, Nullability)])
info
                Maybe (Nullability, [(Text, Nullability)])
Nothing -> case Node (Lexeme Text) -> Maybe AccessPath
exprToPath Node (Lexeme Text)
funcExpr of
                    Just AccessPath
path -> case AccessPath -> LinterState -> Maybe (Node (Lexeme Text))
getDeclaredType AccessPath
path LinterState
lst of
                        Just (Fix (C.VarDecl Node (Lexeme Text)
ty Lexeme Text
_ [Node (Lexeme Text)]
_)) ->
                            let getTypeName :: Fix (NodeF (Lexeme a)) -> Maybe a
getTypeName Fix (NodeF (Lexeme a))
t = case Fix (NodeF (Lexeme a)) -> NodeF (Lexeme a) (Fix (NodeF (Lexeme a)))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Fix (NodeF (Lexeme a))
t of
                                    C.TyUserDefined Lexeme a
name -> a -> Maybe a
forall a. a -> Maybe a
Just (Lexeme a -> a
forall text. Lexeme text -> text
C.lexemeText Lexeme a
name)
                                    C.TyFunc Lexeme a
name -> a -> Maybe a
forall a. a -> Maybe a
Just (Lexeme a -> a
forall text. Lexeme text -> text
C.lexemeText Lexeme a
name)
                                    C.TyPointer Fix (NodeF (Lexeme a))
t' -> Fix (NodeF (Lexeme a)) -> Maybe a
getTypeName Fix (NodeF (Lexeme a))
t'
                                    C.TyConst Fix (NodeF (Lexeme a))
t' -> Fix (NodeF (Lexeme a)) -> Maybe a
getTypeName Fix (NodeF (Lexeme a))
t'
                                    NodeF (Lexeme a) (Fix (NodeF (Lexeme a)))
_ -> Maybe a
forall a. Maybe a
Nothing
                            in case Node (Lexeme Text) -> Maybe Text
forall a. Fix (NodeF (Lexeme a)) -> Maybe a
getTypeName Node (Lexeme Text)
ty of
                                Just Text
name -> Text
-> Map Text (Nullability, [(Text, Nullability)])
-> Maybe (Nullability, [(Text, Nullability)])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name (LinterState -> Map Text (Nullability, [(Text, Nullability)])
functionDefs LinterState
lst)
                                Maybe Text
Nothing   -> Maybe (Nullability, [(Text, Nullability)])
forall a. Maybe a
Nothing
                        Maybe (Node (Lexeme Text))
_ -> Maybe (Nullability, [(Text, Nullability)])
forall a. Maybe a
Nothing
                    Maybe AccessPath
Nothing -> Maybe (Nullability, [(Text, Nullability)])
forall a. Maybe a
Nothing

        case Maybe (Nullability, [(Text, Nullability)])
mFuncInfo' of
            Just (Nullability
_, [(Text, Nullability)]
paramNullabilities) ->
                [(Node (Lexeme Text), (Text, Nullability))]
-> ((Node (Lexeme Text), (Text, Nullability))
    -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Node (Lexeme Text)]
-> [(Text, Nullability)]
-> [(Node (Lexeme Text), (Text, Nullability))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Node (Lexeme Text)]
args [(Text, Nullability)]
paramNullabilities) (((Node (Lexeme Text), (Text, Nullability))
  -> StateT LinterState (State [Diagnostic CimplePos]) ())
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> ((Node (Lexeme Text), (Text, Nullability))
    -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$ \(Node (Lexeme Text)
arg, (Text
_, Nullability
paramNullability)) ->
                    let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
arg SState
st'
                        -- Don't warn again if it's a non-null cast (CastExpr already warned)
                        isCastToNonnull :: Bool
isCastToNonnull = case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
arg of
                            C.CastExpr Node (Lexeme Text)
ty Node (Lexeme Text)
_ -> Node (Lexeme Text) -> Bool
isNonnull Node (Lexeme Text)
ty
                            NodeF (Lexeme Text) (Node (Lexeme Text))
_               -> Bool
False
                    in Bool
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Nullability
paramNullability Nullability -> Nullability -> Bool
forall a. Eq a => a -> a -> Bool
== Nullability
NonNullVar Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isCastToNonnull Bool -> Bool -> Bool
&& (SVal -> Bool) -> SVal -> SState -> Bool
S.canBeNull (LinterState -> SVal -> Bool
isDeclNonNull LinterState
lst) SVal
v SState
st') (StateT LinterState (State [Diagnostic CimplePos]) ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
                        StateT [Diagnostic CimplePos] Identity ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (StateT [Diagnostic CimplePos] Identity ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> StateT [Diagnostic CimplePos] Identity ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Node (Lexeme Text)
-> Doc AnsiStyle
-> StateT [Diagnostic CimplePos] Identity ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
String -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> String
currentFile LinterState
lst) Node (Lexeme Text)
arg (Doc AnsiStyle
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
                            Doc AnsiStyle
"expression" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (Node (Lexeme Text) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Node (Lexeme Text)
arg)
                            Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"is nullable and has not been checked before this call"
            Maybe (Nullability, [(Text, Nullability)])
Nothing -> () -> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        let st'' :: SState
st'' = case Node (Lexeme Text) -> Maybe Text
getFuncName Node (Lexeme Text)
funcExpr of
                Just Text
"assert" -> case [Node (Lexeme Text)]
args of
                    [Node (Lexeme Text)
arg] -> Constraint -> SState -> SState
S.addConstraint (SVal -> Constraint
S.SBool (Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
arg SState
st')) SState
st'
                    [Node (Lexeme Text)]
_     -> SState
st'
                Just Text
"LOGGER_ASSERT" -> case [Node (Lexeme Text)]
args of
                    (Node (Lexeme Text)
_:Node (Lexeme Text)
arg:[Node (Lexeme Text)]
_) -> Constraint -> SState -> SState
S.addConstraint (SVal -> Constraint
S.SBool (Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
arg SState
st')) SState
st'
                    [Node (Lexeme Text)]
_         -> SState
st'
                Maybe Text
_ -> SState
st'
        SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return SState
st''

    C.AssignExpr Node (Lexeme Text)
lhs AssignOp
op Node (Lexeme Text)
rhs -> do
        SState
st' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
st Node (Lexeme Text)
lhs
        SState
st'' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
st' Node (Lexeme Text)
rhs
        LinterState
lst <- StateT LinterState (State [Diagnostic CimplePos]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        case (AssignOp
op, Node (Lexeme Text) -> Maybe AccessPath
exprToPath Node (Lexeme Text)
lhs) of
            (AssignOp
AopEq, Just AccessPath
lhsPath) -> do
                let lhsNullability :: Nullability
lhsNullability = AccessPath -> LinterState -> Nullability
getDeclaredNullability AccessPath
lhsPath LinterState
lst
                    v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
rhs SState
st''
                Bool
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Nullability
lhsNullability Nullability -> Nullability -> Bool
forall a. Eq a => a -> a -> Bool
== Nullability
NonNullVar Bool -> Bool -> Bool
&& (SVal -> Bool) -> SVal -> SState -> Bool
S.canBeNull (LinterState -> SVal -> Bool
isDeclNonNull LinterState
lst) SVal
v SState
st'') (StateT LinterState (State [Diagnostic CimplePos]) ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
                    StateT [Diagnostic CimplePos] Identity ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (StateT [Diagnostic CimplePos] Identity ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> StateT [Diagnostic CimplePos] Identity ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Node (Lexeme Text)
-> Doc AnsiStyle
-> StateT [Diagnostic CimplePos] Identity ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
String -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> String
currentFile LinterState
lst) Node (Lexeme Text)
rhs (Doc AnsiStyle
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
                        Doc AnsiStyle
"expression" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (Node (Lexeme Text) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Node (Lexeme Text)
rhs)
                        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"is nullable and has not been checked before this assignment"
                SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return (SState -> LinterM SState) -> SState -> LinterM SState
forall a b. (a -> b) -> a -> b
$ AccessPath -> SVal -> SState -> SState
S.assign AccessPath
lhsPath SVal
v SState
st''
            (AssignOp, Maybe AccessPath)
_ -> SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return SState
st''

    C.BinaryExpr Node (Lexeme Text)
lhs BinaryOp
op Node (Lexeme Text)
rhs | BinaryOp
op BinaryOp -> [BinaryOp] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BinaryOp
BopPlus, BinaryOp
BopMinus] -> do
        SState
st' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
st Node (Lexeme Text)
lhs
        SState
st'' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
st' Node (Lexeme Text)
rhs
        LinterState
lst <- StateT LinterState (State [Diagnostic CimplePos]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        let check :: Node (Lexeme Text) -> SState -> t (StateT diags Identity) ()
check Node (Lexeme Text)
e SState
s = case (Node (Lexeme Text) -> Maybe AccessPath
exprToPath Node (Lexeme Text)
e, Node (Lexeme Text) -> Maybe AccessPath
exprToPath Node (Lexeme Text)
e Maybe AccessPath
-> (AccessPath -> Maybe (Node (Lexeme Text)))
-> Maybe (Node (Lexeme Text))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AccessPath -> LinterState -> Maybe (Node (Lexeme Text))
`getDeclaredType` LinterState
lst)) of
                (Just AccessPath
_, Just Node (Lexeme Text)
ty) | Node (Lexeme Text) -> Bool
isPointerType Node (Lexeme Text)
ty ->
                    let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
e SState
s
                    in Bool
-> t (StateT diags Identity) () -> t (StateT diags Identity) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((SVal -> Bool) -> SVal -> SState -> Bool
S.canBeNull (LinterState -> SVal -> Bool
isDeclNonNull LinterState
lst) SVal
v SState
s) (t (StateT diags Identity) () -> t (StateT diags Identity) ())
-> t (StateT diags Identity) () -> t (StateT diags Identity) ()
forall a b. (a -> b) -> a -> b
$
                        StateT diags Identity () -> t (StateT diags Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (StateT diags Identity () -> t (StateT diags Identity) ())
-> (Doc AnsiStyle -> StateT diags Identity ())
-> Doc AnsiStyle
-> t (StateT diags Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Node (Lexeme Text) -> Doc AnsiStyle -> StateT diags Identity ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
String -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> String
currentFile LinterState
lst) Node (Lexeme Text)
e (Doc AnsiStyle -> t (StateT diags Identity) ())
-> Doc AnsiStyle -> t (StateT diags Identity) ()
forall a b. (a -> b) -> a -> b
$
                            Doc AnsiStyle
"pointer" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (Node (Lexeme Text) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Node (Lexeme Text)
e)
                            Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"is nullable and has not been checked before this arithmetic"
                (Maybe AccessPath, Maybe (Node (Lexeme Text)))
_ -> () -> t (StateT diags Identity) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Node (Lexeme Text)
-> SState -> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (t :: (* -> *) -> * -> *) diags.
(MonadTrans t, HasDiagnosticsRich diags CimplePos,
 Monad (t (StateT diags Identity))) =>
Node (Lexeme Text) -> SState -> t (StateT diags Identity) ()
check Node (Lexeme Text)
lhs SState
st''
        Node (Lexeme Text)
-> SState -> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (t :: (* -> *) -> * -> *) diags.
(MonadTrans t, HasDiagnosticsRich diags CimplePos,
 Monad (t (StateT diags Identity))) =>
Node (Lexeme Text) -> SState -> t (StateT diags Identity) ()
check Node (Lexeme Text)
rhs SState
st''
        SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return SState
st''

    NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> (SState -> Node (Lexeme Text) -> LinterM SState)
-> SState
-> NodeF (Lexeme Text) (Node (Lexeme Text))
-> LinterM SState
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
st (Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
expr)

data ProgramDefs = ProgramDefs
    { ProgramDefs -> Map Text TypeEnv
programStructs   :: Map Text TypeEnv
    , ProgramDefs
-> Map
     Text
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
programFunctions :: Map Text (Nullability, [(Text, Nullability)], FilePath, C.Node (Lexeme Text))
    , ProgramDefs -> TypeEnv
programGlobals   :: TypeEnv
    , ProgramDefs -> Map Text (Nullability, [(Text, Nullability)])
programTypedefs  :: Map Text (Nullability, [(Text, Nullability)])
    }

mergeNullability :: Nullability -> Nullability -> Maybe Nullability
mergeNullability :: Nullability -> Nullability -> Maybe Nullability
mergeNullability Nullability
UnspecifiedNullability Nullability
x = Nullability -> Maybe Nullability
forall a. a -> Maybe a
Just Nullability
x
mergeNullability Nullability
x Nullability
UnspecifiedNullability = Nullability -> Maybe Nullability
forall a. a -> Maybe a
Just Nullability
x
mergeNullability Nullability
x Nullability
y                      | Nullability
x Nullability -> Nullability -> Bool
forall a. Eq a => a -> a -> Bool
== Nullability
y              = Nullability -> Maybe Nullability
forall a. a -> Maybe a
Just Nullability
x
mergeNullability Nullability
_ Nullability
_                      = Maybe Nullability
forall a. Maybe a
Nothing

data Mismatch
    = RetMismatch Nullability Nullability
    | ParamMismatch Int Text Nullability Nullability
    | ParamCountMismatch Int Int

mergeFunctionInfos :: (Nullability, [(Text, Nullability)]) -> (Nullability, [(Text, Nullability)]) -> Either Mismatch (Nullability, [(Text, Nullability)])
mergeFunctionInfos :: (Nullability, [(Text, Nullability)])
-> (Nullability, [(Text, Nullability)])
-> Either Mismatch (Nullability, [(Text, Nullability)])
mergeFunctionInfos (Nullability
r1, [(Text, Nullability)]
p1) (Nullability
r2, [(Text, Nullability)]
p2) = do
    Nullability
r <- Either Mismatch Nullability
-> (Nullability -> Either Mismatch Nullability)
-> Maybe Nullability
-> Either Mismatch Nullability
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Mismatch -> Either Mismatch Nullability
forall a b. a -> Either a b
Left (Mismatch -> Either Mismatch Nullability)
-> Mismatch -> Either Mismatch Nullability
forall a b. (a -> b) -> a -> b
$ Nullability -> Nullability -> Mismatch
RetMismatch Nullability
r1 Nullability
r2) Nullability -> Either Mismatch Nullability
forall a b. b -> Either a b
Right (Maybe Nullability -> Either Mismatch Nullability)
-> Maybe Nullability -> Either Mismatch Nullability
forall a b. (a -> b) -> a -> b
$ Nullability -> Nullability -> Maybe Nullability
mergeNullability Nullability
r1 Nullability
r2
    [(Text, Nullability)]
p <- if [(Text, Nullability)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Nullability)]
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(Text, Nullability)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Nullability)]
p2
         then [(Int, (Text, Nullability), (Text, Nullability))]
-> ((Int, (Text, Nullability), (Text, Nullability))
    -> Either Mismatch (Text, Nullability))
-> Either Mismatch [(Text, Nullability)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Int]
-> [(Text, Nullability)]
-> [(Text, Nullability)]
-> [(Int, (Text, Nullability), (Text, Nullability))]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..] [(Text, Nullability)]
p1 [(Text, Nullability)]
p2) (((Int, (Text, Nullability), (Text, Nullability))
  -> Either Mismatch (Text, Nullability))
 -> Either Mismatch [(Text, Nullability)])
-> ((Int, (Text, Nullability), (Text, Nullability))
    -> Either Mismatch (Text, Nullability))
-> Either Mismatch [(Text, Nullability)]
forall a b. (a -> b) -> a -> b
$ \(Int
i, (Text
n1, Nullability
v1), (Text
_, Nullability
v2)) ->
            case Nullability -> Nullability -> Maybe Nullability
mergeNullability Nullability
v1 Nullability
v2 of
                Just Nullability
v  -> (Text, Nullability) -> Either Mismatch (Text, Nullability)
forall a b. b -> Either a b
Right (Text
n1, Nullability
v)
                Maybe Nullability
Nothing -> Mismatch -> Either Mismatch (Text, Nullability)
forall a b. a -> Either a b
Left (Mismatch -> Either Mismatch (Text, Nullability))
-> Mismatch -> Either Mismatch (Text, Nullability)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Nullability -> Nullability -> Mismatch
ParamMismatch Int
i Text
n1 Nullability
v1 Nullability
v2
         else Mismatch -> Either Mismatch [(Text, Nullability)]
forall a b. a -> Either a b
Left (Mismatch -> Either Mismatch [(Text, Nullability)])
-> Mismatch -> Either Mismatch [(Text, Nullability)]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Mismatch
ParamCountMismatch ([(Text, Nullability)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Nullability)]
p1) ([(Text, Nullability)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Nullability)]
p2)
    (Nullability, [(Text, Nullability)])
-> Either Mismatch (Nullability, [(Text, Nullability)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Nullability
r, [(Text, Nullability)]
p)

getParams :: C.Node (Lexeme Text) -> [C.Node (Lexeme Text)]
getParams :: Node (Lexeme Text) -> [Node (Lexeme Text)]
getParams (Fix (C.FunctionPrototype Node (Lexeme Text)
_ Lexeme Text
_ [Node (Lexeme Text)]
ps)) = [Node (Lexeme Text)]
ps
getParams Node (Lexeme Text)
_                                  = []

collectDefs :: AstActions (State (ProgramDefs, [Diagnostic CimplePos])) Text
collectDefs :: AstActions (State (ProgramDefs, [Diagnostic CimplePos])) Text
collectDefs = AstActions (State (ProgramDefs, [Diagnostic CimplePos])) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode :: String
-> Node (Lexeme Text)
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
doNode = \String
file Node (Lexeme Text)
node State (ProgramDefs, [Diagnostic CimplePos]) ()
act ->
        case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
            C.Typedef (Fix (C.Struct Lexeme Text
_ [Node (Lexeme Text)]
members)) Lexeme Text
structName [Node (Lexeme Text)]
_ -> do
                let fieldEnv :: TypeEnv
fieldEnv = [(Text, VarInfo)] -> TypeEnv
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, VarInfo)] -> TypeEnv)
-> ([Node (Lexeme Text)] -> [(Text, VarInfo)])
-> [Node (Lexeme Text)]
-> TypeEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node (Lexeme Text) -> [(Text, VarInfo)])
-> [Node (Lexeme Text)] -> [(Text, VarInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Node (Lexeme Text) -> [(Text, VarInfo)]
getFieldDecls ([Node (Lexeme Text)] -> TypeEnv)
-> [Node (Lexeme Text)] -> TypeEnv
forall a b. (a -> b) -> a -> b
$ [Node (Lexeme Text)]
members
                ((ProgramDefs, [Diagnostic CimplePos])
 -> (ProgramDefs, [Diagnostic CimplePos]))
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((ProgramDefs, [Diagnostic CimplePos])
  -> (ProgramDefs, [Diagnostic CimplePos]))
 -> State (ProgramDefs, [Diagnostic CimplePos]) ())
-> ((ProgramDefs, [Diagnostic CimplePos])
    -> (ProgramDefs, [Diagnostic CimplePos]))
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$ \(ProgramDefs
s, [Diagnostic CimplePos]
errs) -> (ProgramDefs
s { programStructs :: Map Text TypeEnv
programStructs = Text -> TypeEnv -> Map Text TypeEnv -> Map Text TypeEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Lexeme Text -> Text
forall text. Lexeme text -> text
C.lexemeText Lexeme Text
structName) TypeEnv
fieldEnv (ProgramDefs -> Map Text TypeEnv
programStructs ProgramDefs
s) }, [Diagnostic CimplePos]
errs)
                State (ProgramDefs, [Diagnostic CimplePos]) ()
act
            C.TypedefFunction Node (Lexeme Text)
proto -> do
                case Node (Lexeme Text) -> Maybe Text
forall a. Show a => Node (Lexeme a) -> Maybe a
functionName Node (Lexeme Text)
proto of
                    Just Text
name -> do
                        let (Fix (C.FunctionPrototype Node (Lexeme Text)
retType Lexeme Text
_ [Node (Lexeme Text)]
params)) = Node (Lexeme Text)
proto
                        let retNullability :: Nullability
retNullability = Node (Lexeme Text) -> Nullability
getNullability' Node (Lexeme Text)
retType
                        let paramInfos :: [(Text, Nullability)]
paramInfos = (Node (Lexeme Text) -> (Text, Nullability))
-> [Node (Lexeme Text)] -> [(Text, Nullability)]
forall a b. (a -> b) -> [a] -> [b]
map Node (Lexeme Text) -> (Text, Nullability)
getParamInfo [Node (Lexeme Text)]
params
                        ((ProgramDefs, [Diagnostic CimplePos])
 -> (ProgramDefs, [Diagnostic CimplePos]))
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((ProgramDefs, [Diagnostic CimplePos])
  -> (ProgramDefs, [Diagnostic CimplePos]))
 -> State (ProgramDefs, [Diagnostic CimplePos]) ())
-> ((ProgramDefs, [Diagnostic CimplePos])
    -> (ProgramDefs, [Diagnostic CimplePos]))
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$ \(ProgramDefs
s, [Diagnostic CimplePos]
errs) -> (ProgramDefs
s { programTypedefs :: Map Text (Nullability, [(Text, Nullability)])
programTypedefs = Text
-> (Nullability, [(Text, Nullability)])
-> Map Text (Nullability, [(Text, Nullability)])
-> Map Text (Nullability, [(Text, Nullability)])
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name (Nullability
retNullability, [(Text, Nullability)]
paramInfos) (ProgramDefs -> Map Text (Nullability, [(Text, Nullability)])
programTypedefs ProgramDefs
s) }, [Diagnostic CimplePos]
errs)
                    Maybe Text
Nothing -> () -> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                State (ProgramDefs, [Diagnostic CimplePos]) ()
act
            C.FunctionPrototype Node (Lexeme Text)
retType (C.L AlexPosn
_ LexemeClass
_ Text
name) [Node (Lexeme Text)]
params -> do
                let retNullability :: Nullability
retNullability = Node (Lexeme Text) -> Nullability
getNullability' Node (Lexeme Text)
retType
                let currentParamInfos :: [(Text, Nullability)]
currentParamInfos = (Node (Lexeme Text) -> (Text, Nullability))
-> [Node (Lexeme Text)] -> [(Text, Nullability)]
forall a b. (a -> b) -> [a] -> [b]
map Node (Lexeme Text) -> (Text, Nullability)
getParamInfo [Node (Lexeme Text)]
params
                (ProgramDefs
s, [Diagnostic CimplePos]
errs) <- State
  (ProgramDefs, [Diagnostic CimplePos])
  (ProgramDefs, [Diagnostic CimplePos])
forall s (m :: * -> *). MonadState s m => m s
State.get
                case Text
-> Map
     Text
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
-> Maybe
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name (ProgramDefs
-> Map
     Text
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
programFunctions ProgramDefs
s) of
                    Maybe
  (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
Nothing ->
                        (ProgramDefs, [Diagnostic CimplePos])
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (ProgramDefs
s { programFunctions :: Map
  Text
  (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
programFunctions = Text
-> (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
-> Map
     Text
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
-> Map
     Text
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name (Nullability
retNullability, [(Text, Nullability)]
currentParamInfos, String
file, Node (Lexeme Text)
node) (ProgramDefs
-> Map
     Text
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
programFunctions ProgramDefs
s) }, [Diagnostic CimplePos]
errs)
                    Just (Nullability
oldRet, [(Text, Nullability)]
oldParamInfos, String
oldFile, Node (Lexeme Text)
oldNode) ->
                        case (Nullability, [(Text, Nullability)])
-> (Nullability, [(Text, Nullability)])
-> Either Mismatch (Nullability, [(Text, Nullability)])
mergeFunctionInfos (Nullability
oldRet, [(Text, Nullability)]
oldParamInfos) (Nullability
retNullability, [(Text, Nullability)]
currentParamInfos) of
                            Right (Nullability
newRet, [(Text, Nullability)]
newParamInfos) ->
                                (ProgramDefs, [Diagnostic CimplePos])
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (ProgramDefs
s { programFunctions :: Map
  Text
  (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
programFunctions = Text
-> (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
-> Map
     Text
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
-> Map
     Text
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name (Nullability
newRet, [(Text, Nullability)]
newParamInfos, String
oldFile, Node (Lexeme Text)
node) (ProgramDefs
-> Map
     Text
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
programFunctions ProgramDefs
s) }, [Diagnostic CimplePos]
errs)
                            Left Mismatch
mismatch -> do
                                let (CimplePos
pos, Int
len) = String -> Node (Lexeme Text) -> (CimplePos, Int)
nodePosAndLen String
file Node (Lexeme Text)
node
                                let diag :: Diagnostic CimplePos
diag = case Mismatch
mismatch of
                                        RetMismatch Nullability
_ Nullability
_ ->
                                            CimplePos
-> Int
-> DiagnosticLevel
-> Doc AnsiStyle
-> Maybe Text
-> [DiagnosticSpan CimplePos]
-> [(DiagnosticLevel, Doc AnsiStyle)]
-> Diagnostic CimplePos
forall pos.
pos
-> Int
-> DiagnosticLevel
-> Doc AnsiStyle
-> Maybe Text
-> [DiagnosticSpan pos]
-> [(DiagnosticLevel, Doc AnsiStyle)]
-> Diagnostic pos
Diagnostic CimplePos
pos Int
len DiagnosticLevel
WarningLevel
                                                (Doc AnsiStyle
"nullability mismatch for return type of function" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (Text -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Text
name))
                                                (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"nullability")
                                                [ CimplePos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan CimplePos
forall pos. pos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan pos
DiagnosticSpan ((CimplePos, Int) -> CimplePos
forall a b. (a, b) -> a
fst ((CimplePos, Int) -> CimplePos) -> (CimplePos, Int) -> CimplePos
forall a b. (a -> b) -> a -> b
$ String -> Node (Lexeme Text) -> (CimplePos, Int)
nodePosAndLen String
oldFile Node (Lexeme Text)
oldNode) ((CimplePos, Int) -> Int
forall a b. (a, b) -> b
snd ((CimplePos, Int) -> Int) -> (CimplePos, Int) -> Int
forall a b. (a -> b) -> a -> b
$ String -> Node (Lexeme Text) -> (CimplePos, Int)
nodePosAndLen String
oldFile Node (Lexeme Text)
oldNode) [ Doc AnsiStyle
"conflict with declaration here" ]
                                                , CimplePos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan CimplePos
forall pos. pos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan pos
DiagnosticSpan CimplePos
pos Int
len [ Doc AnsiStyle
"found mismatch here" ]
                                                ]
                                                []
                                        ParamMismatch Int
i Text
pname Nullability
_ Nullability
_ ->
                                            let oldParam :: Node (Lexeme Text)
oldParam = Node (Lexeme Text) -> [Node (Lexeme Text)]
getParams Node (Lexeme Text)
oldNode [Node (Lexeme Text)] -> Int -> Node (Lexeme Text)
forall a. [a] -> Int -> a
!! Int
i
                                                newParam :: Node (Lexeme Text)
newParam = [Node (Lexeme Text)]
params [Node (Lexeme Text)] -> Int -> Node (Lexeme Text)
forall a. [a] -> Int -> a
!! Int
i
                                                (CimplePos
oldPos, Int
oldLen) = String -> Node (Lexeme Text) -> (CimplePos, Int)
nodePosAndLen String
oldFile Node (Lexeme Text)
oldParam
                                                (CimplePos
newPos, Int
newLen) = String -> Node (Lexeme Text) -> (CimplePos, Int)
nodePosAndLen String
file Node (Lexeme Text)
newParam
                                            in CimplePos
-> Int
-> DiagnosticLevel
-> Doc AnsiStyle
-> Maybe Text
-> [DiagnosticSpan CimplePos]
-> [(DiagnosticLevel, Doc AnsiStyle)]
-> Diagnostic CimplePos
forall pos.
pos
-> Int
-> DiagnosticLevel
-> Doc AnsiStyle
-> Maybe Text
-> [DiagnosticSpan pos]
-> [(DiagnosticLevel, Doc AnsiStyle)]
-> Diagnostic pos
Diagnostic CimplePos
newPos Int
newLen DiagnosticLevel
WarningLevel
                                                (Doc AnsiStyle
"nullability mismatch for parameter" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens (Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (Text -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Text
pname)) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"of function" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (Text -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Text
name))
                                                (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"nullability")
                                                [ CimplePos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan CimplePos
forall pos. pos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan pos
DiagnosticSpan CimplePos
oldPos Int
oldLen [ Doc AnsiStyle
"conflict with declaration here" ]
                                                , CimplePos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan CimplePos
forall pos. pos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan pos
DiagnosticSpan CimplePos
newPos Int
newLen [ Doc AnsiStyle
"found mismatch here" ]
                                                ]
                                                []
                                        ParamCountMismatch Int
_ Int
_ ->
                                            CimplePos
-> Int
-> DiagnosticLevel
-> Doc AnsiStyle
-> Maybe Text
-> [DiagnosticSpan CimplePos]
-> [(DiagnosticLevel, Doc AnsiStyle)]
-> Diagnostic CimplePos
forall pos.
pos
-> Int
-> DiagnosticLevel
-> Doc AnsiStyle
-> Maybe Text
-> [DiagnosticSpan pos]
-> [(DiagnosticLevel, Doc AnsiStyle)]
-> Diagnostic pos
Diagnostic CimplePos
pos Int
len DiagnosticLevel
WarningLevel
                                                (Doc AnsiStyle
"parameter count mismatch for function" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (Text -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Text
name))
                                                (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"nullability")
                                                [ CimplePos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan CimplePos
forall pos. pos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan pos
DiagnosticSpan ((CimplePos, Int) -> CimplePos
forall a b. (a, b) -> a
fst ((CimplePos, Int) -> CimplePos) -> (CimplePos, Int) -> CimplePos
forall a b. (a -> b) -> a -> b
$ String -> Node (Lexeme Text) -> (CimplePos, Int)
nodePosAndLen String
oldFile Node (Lexeme Text)
oldNode) ((CimplePos, Int) -> Int
forall a b. (a, b) -> b
snd ((CimplePos, Int) -> Int) -> (CimplePos, Int) -> Int
forall a b. (a -> b) -> a -> b
$ String -> Node (Lexeme Text) -> (CimplePos, Int)
nodePosAndLen String
oldFile Node (Lexeme Text)
oldNode) [ Doc AnsiStyle
"conflict with declaration here" ]
                                                , CimplePos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan CimplePos
forall pos. pos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan pos
DiagnosticSpan CimplePos
pos Int
len [ Doc AnsiStyle
"found mismatch here" ]
                                                ]
                                                []
                                (ProgramDefs, [Diagnostic CimplePos])
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (ProgramDefs
s, Diagnostic CimplePos
diag Diagnostic CimplePos
-> [Diagnostic CimplePos] -> [Diagnostic CimplePos]
forall a. a -> [a] -> [a]
: [Diagnostic CimplePos]
errs)
                                State (ProgramDefs, [Diagnostic CimplePos]) ()
act
            C.ConstDecl Node (Lexeme Text)
ty (C.L AlexPosn
_ LexemeClass
_ Text
name) -> do
                ((ProgramDefs, [Diagnostic CimplePos])
 -> (ProgramDefs, [Diagnostic CimplePos]))
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((ProgramDefs, [Diagnostic CimplePos])
  -> (ProgramDefs, [Diagnostic CimplePos]))
 -> State (ProgramDefs, [Diagnostic CimplePos]) ())
-> ((ProgramDefs, [Diagnostic CimplePos])
    -> (ProgramDefs, [Diagnostic CimplePos]))
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$ \(ProgramDefs
s, [Diagnostic CimplePos]
errs) -> (ProgramDefs
s { programGlobals :: TypeEnv
programGlobals = Text -> VarInfo -> TypeEnv -> TypeEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name (Node (Lexeme Text) -> Nullability
getNullability' Node (Lexeme Text)
ty, Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just Node (Lexeme Text)
ty) (ProgramDefs -> TypeEnv
programGlobals ProgramDefs
s) }, [Diagnostic CimplePos]
errs)
                State (ProgramDefs, [Diagnostic CimplePos]) ()
act
            C.ConstDefn Scope
_ Node (Lexeme Text)
ty (C.L AlexPosn
_ LexemeClass
_ Text
name) Node (Lexeme Text)
_ -> do
                ((ProgramDefs, [Diagnostic CimplePos])
 -> (ProgramDefs, [Diagnostic CimplePos]))
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((ProgramDefs, [Diagnostic CimplePos])
  -> (ProgramDefs, [Diagnostic CimplePos]))
 -> State (ProgramDefs, [Diagnostic CimplePos]) ())
-> ((ProgramDefs, [Diagnostic CimplePos])
    -> (ProgramDefs, [Diagnostic CimplePos]))
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$ \(ProgramDefs
s, [Diagnostic CimplePos]
errs) -> (ProgramDefs
s { programGlobals :: TypeEnv
programGlobals = Text -> VarInfo -> TypeEnv -> TypeEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name (Node (Lexeme Text) -> Nullability
getNullability' Node (Lexeme Text)
ty, Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just Node (Lexeme Text)
ty) (ProgramDefs -> TypeEnv
programGlobals ProgramDefs
s) }, [Diagnostic CimplePos]
errs)
                State (ProgramDefs, [Diagnostic CimplePos]) ()
act
            NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> State (ProgramDefs, [Diagnostic CimplePos]) ()
act
    }
  where
    getFieldDecls :: Node (Lexeme Text) -> [(Text, VarInfo)]
getFieldDecls (Fix (C.MemberDecl (Fix (C.VarDecl Node (Lexeme Text)
ty Lexeme Text
name [Node (Lexeme Text)]
_)) Maybe (Lexeme Text)
_)) =
        [(Lexeme Text -> Text
forall text. Lexeme text -> text
C.lexemeText Lexeme Text
name, (Node (Lexeme Text) -> Nullability
getNullability' Node (Lexeme Text)
ty, Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just Node (Lexeme Text)
ty))]
    getFieldDecls Node (Lexeme Text)
_ = []

    getParamInfo :: Node (Lexeme Text) -> (Text, Nullability)
getParamInfo node :: Node (Lexeme Text)
node@(Fix (C.VarDecl {})) =
        let (C.VarDecl Node (Lexeme Text)
_ (C.L AlexPosn
_ LexemeClass
_ Text
name) [Node (Lexeme Text)]
_) = Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node
        in (Text
name, Node (Lexeme Text) -> Nullability
getNullability' Node (Lexeme Text)
node)
    getParamInfo Node (Lexeme Text)
_ = (Text
"", Nullability
NonNullVar)

runAnalysis :: C.Node (Lexeme Text) -> LinterM ()
runAnalysis :: Node (Lexeme Text)
-> StateT LinterState (State [Diagnostic CimplePos]) ()
runAnalysis defn :: Node (Lexeme Text)
defn@(Fix (C.FunctionDefn Scope
_ Node (Lexeme Text)
proto Node (Lexeme Text)
body)) = do
    LinterState
st <- StateT LinterState (State [Diagnostic CimplePos]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
    let localDecls :: TypeEnv
localDecls = Node (Lexeme Text) -> TypeEnv
collectTypeEnv Node (Lexeme Text)
defn
    -- Preserve merged param info from declarations; localDecls from the definition
    -- might have fewer annotations. Map.union is left-biased, so we want (typeEnv st) first.
    let tenv :: TypeEnv
tenv = TypeEnv -> TypeEnv -> TypeEnv
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (LinterState -> TypeEnv
typeEnv LinterState
st) TypeEnv
localDecls
    let st' :: LinterState
st' = LinterState
st { typeEnv :: TypeEnv
typeEnv = TypeEnv
tenv }
    let (Node
entry, CFG
cfg) = Node (Lexeme Text) -> (Node, CFG)
fromFunction Node (Lexeme Text)
defn
    let problem :: Dataflow Node EdgeType SState
problem = LinterState -> Dataflow Node EdgeType SState
nullabilityProblem LinterState
st'
    let results :: Map Node SState
results = Node -> CFG -> Dataflow Node EdgeType SState -> Map Node SState
forall node state edge.
(Ord node, Eq state) =>
node
-> Map node [(edge, node)]
-> Dataflow node edge state
-> Map node state
solve Node
entry CFG
cfg Dataflow Node EdgeType SState
problem

    [(Node, SState)]
-> ((Node, SState)
    -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Node SState -> [(Node, SState)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Node SState
results) (((Node, SState)
  -> StateT LinterState (State [Diagnostic CimplePos]) ())
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> ((Node, SState)
    -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$ \(Node
node, SState
s) ->
        case Node
node of
            Node Int
_ (StmtNode Node (Lexeme Text)
stmt)   -> (LinterState -> LinterState)
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall s (m :: * -> *) a. (s -> s) -> StateT s m a -> StateT s m a
State.withStateT (\LinterState
_ -> LinterState
st') (StateT LinterState (State [Diagnostic CimplePos]) ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$ LinterM SState
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LinterM SState
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> LinterM SState
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$ SState -> Node (Lexeme Text) -> LinterM SState
analyseAtomicStmt SState
s Node (Lexeme Text)
stmt
            Node Int
_ (BranchNode Node (Lexeme Text)
cond) -> (LinterState -> LinterState)
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall s (m :: * -> *) a. (s -> s) -> StateT s m a -> StateT s m a
State.withStateT (\LinterState
_ -> LinterState
st') (StateT LinterState (State [Diagnostic CimplePos]) ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$ LinterM SState
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LinterM SState
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> LinterM SState
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$ SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
s Node (Lexeme Text)
cond
            Node
_ -> () -> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
runAnalysis Node (Lexeme Text)
_ = () -> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

analyseAtomicStmt :: S.SState -> C.Node (Lexeme Text) -> LinterM S.SState
analyseAtomicStmt :: SState -> Node (Lexeme Text) -> LinterM SState
analyseAtomicStmt SState
s (Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) = case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
    C.ExprStmt Node (Lexeme Text)
e -> SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
s Node (Lexeme Text)
e
    C.VarDeclStmt (Fix (C.VarDecl Node (Lexeme Text)
ty (C.L AlexPosn
_ LexemeClass
_ Text
name) [Node (Lexeme Text)]
_)) (Just Node (Lexeme Text)
i) -> do
        SState
s' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
s Node (Lexeme Text)
i
        LinterState
lst <- StateT LinterState (State [Diagnostic CimplePos]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
i SState
s'
            path :: AccessPath
path = String -> AccessPath
PathVar (Text -> String
Text.unpack Text
name)
        Bool
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Node (Lexeme Text) -> Nullability
getNullability' Node (Lexeme Text)
ty Nullability -> Nullability -> Bool
forall a. Eq a => a -> a -> Bool
== Nullability
NonNullVar Bool -> Bool -> Bool
&& (SVal -> Bool) -> SVal -> SState -> Bool
S.canBeNull (LinterState -> SVal -> Bool
isDeclNonNull LinterState
lst) SVal
v SState
s') (StateT LinterState (State [Diagnostic CimplePos]) ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
            StateT [Diagnostic CimplePos] Identity ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (StateT [Diagnostic CimplePos] Identity ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> StateT [Diagnostic CimplePos] Identity ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Node (Lexeme Text)
-> Doc AnsiStyle
-> StateT [Diagnostic CimplePos] Identity ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
String -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> String
currentFile LinterState
lst) Node (Lexeme Text)
i (Doc AnsiStyle
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
                Doc AnsiStyle
"expression" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (Node (Lexeme Text) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Node (Lexeme Text)
i)
                Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"is nullable and has not been checked before this assignment"
        SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return (SState -> LinterM SState) -> SState -> LinterM SState
forall a b. (a -> b) -> a -> b
$ if Node (Lexeme Text) -> Bool
isPointerType Node (Lexeme Text)
ty then AccessPath -> SVal -> SState -> SState
S.assign AccessPath
path SVal
v SState
s' else SState
s'
    C.Return (Just Node (Lexeme Text)
e) -> do
        SState
s' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
s Node (Lexeme Text)
e
        LinterState
lst <- StateT LinterState (State [Diagnostic CimplePos]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        let v :: SVal
v = Node (Lexeme Text) -> SState -> SVal
evaluate Node (Lexeme Text)
e SState
s'
        Bool
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LinterState -> Nullability
currentFuncRet LinterState
lst Nullability -> Nullability -> Bool
forall a. Eq a => a -> a -> Bool
== Nullability
NonNullVar Bool -> Bool -> Bool
&& (SVal -> Bool) -> SVal -> SState -> Bool
S.canBeNull (LinterState -> SVal -> Bool
isDeclNonNull LinterState
lst) SVal
v SState
s') (StateT LinterState (State [Diagnostic CimplePos]) ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
            StateT [Diagnostic CimplePos] Identity ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (StateT [Diagnostic CimplePos] Identity ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> StateT [Diagnostic CimplePos] Identity ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Node (Lexeme Text)
-> Doc AnsiStyle
-> StateT [Diagnostic CimplePos] Identity ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
String -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> String
currentFile LinterState
lst) Node (Lexeme Text)
e (Doc AnsiStyle
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$
                Doc AnsiStyle
"expression" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (Node (Lexeme Text) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Node (Lexeme Text)
e)
                Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"is nullable and has not been checked before this return"
        SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return SState
s'
    C.IfStmt Node (Lexeme Text)
cond Node (Lexeme Text)
_ Maybe (Node (Lexeme Text))
_ -> SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
s Node (Lexeme Text)
cond
    C.WhileStmt Node (Lexeme Text)
cond Node (Lexeme Text)
_ -> SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
s Node (Lexeme Text)
cond
    C.DoWhileStmt Node (Lexeme Text)
_ Node (Lexeme Text)
cond -> SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
s Node (Lexeme Text)
cond
    C.ForStmt Node (Lexeme Text)
init' Node (Lexeme Text)
cond Node (Lexeme Text)
step Node (Lexeme Text)
_ -> do
        SState
s' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
s Node (Lexeme Text)
init'
        SState
s'' <- SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
s' Node (Lexeme Text)
cond
        SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
s'' Node (Lexeme Text)
step
    C.SwitchStmt Node (Lexeme Text)
expr [Node (Lexeme Text)]
_ -> SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
s Node (Lexeme Text)
expr
    C.Case Node (Lexeme Text)
expr Node (Lexeme Text)
_ -> SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
s Node (Lexeme Text)
expr
    C.Label Lexeme Text
_ Node (Lexeme Text)
_ -> SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return SState
s -- Body analyzed as its own node
    C.PreprocIf Node (Lexeme Text)
cond [Node (Lexeme Text)]
_ Node (Lexeme Text)
_ -> SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
s Node (Lexeme Text)
cond
    C.PreprocIfdef Lexeme Text
_ [Node (Lexeme Text)]
_ Node (Lexeme Text)
_ -> SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return SState
s -- Identifier is atomic
    C.PreprocIfndef Lexeme Text
_ [Node (Lexeme Text)]
_ Node (Lexeme Text)
_ -> SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return SState
s -- Identifier is atomic
    C.PreprocElif Node (Lexeme Text)
cond [Node (Lexeme Text)]
_ Node (Lexeme Text)
_ -> SState -> Node (Lexeme Text) -> LinterM SState
analyseExpr SState
s Node (Lexeme Text)
cond
    NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> SState -> LinterM SState
forall (m :: * -> *) a. Monad m => a -> m a
return SState
s -- Other nodes don't contain expressions to check

linter :: ProgramDefs -> AstActions (State [Diagnostic CimplePos]) Text
linter :: ProgramDefs -> AstActions (State [Diagnostic CimplePos]) Text
linter ProgramDefs
pdefs = AstActions (State [Diagnostic CimplePos]) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode :: String
-> Node (Lexeme Text)
-> StateT [Diagnostic CimplePos] Identity ()
-> StateT [Diagnostic CimplePos] Identity ()
doNode = \String
file Node (Lexeme Text)
node StateT [Diagnostic CimplePos] Identity ()
act ->
        case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
            C.FunctionDefn Scope
_ proto :: Node (Lexeme Text)
proto@(Fix (C.FunctionPrototype Node (Lexeme Text)
retType (C.L AlexPosn
_ LexemeClass
_ Text
name) [Node (Lexeme Text)]
_)) Node (Lexeme Text)
_ ->
                let localParams :: [(Text, VarInfo)]
localParams = Node (Lexeme Text) -> [(Text, VarInfo)]
getParamTypes Node (Lexeme Text)
proto
                    (Nullability
retNull, [(Text, VarInfo)]
mergedParamsInfo) = case Text
-> Map
     Text
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
-> Maybe
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name (ProgramDefs
-> Map
     Text
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
programFunctions ProgramDefs
pdefs) of
                        Just (Nullability
r, [(Text, Nullability)]
mergedParams, String
_, Node (Lexeme Text)
_) | [(Text, Nullability)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Nullability)]
mergedParams Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(Text, VarInfo)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, VarInfo)]
localParams ->
                            (Nullability
r, ((Text, VarInfo) -> (Text, Nullability) -> (Text, VarInfo))
-> [(Text, VarInfo)] -> [(Text, Nullability)] -> [(Text, VarInfo)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Text
n, (Nullability
_, Maybe (Node (Lexeme Text))
ty)) (Text
_, Nullability
m) -> (Text
n, (Nullability
m, Maybe (Node (Lexeme Text))
ty))) [(Text, VarInfo)]
localParams [(Text, Nullability)]
mergedParams)
                        Maybe
  (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
_ -> (Node (Lexeme Text) -> Nullability
getNullability' Node (Lexeme Text)
retType, [(Text, VarInfo)]
localParams)
                    tenv :: TypeEnv
tenv = TypeEnv -> TypeEnv -> TypeEnv
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ([(Text, VarInfo)] -> TypeEnv
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, VarInfo)]
mergedParamsInfo) (ProgramDefs -> TypeEnv
programGlobals ProgramDefs
pdefs)
                    fDefs :: Map Text (Nullability, [(Text, Nullability)])
fDefs = Map Text (Nullability, [(Text, Nullability)])
-> Map Text (Nullability, [(Text, Nullability)])
-> Map Text (Nullability, [(Text, Nullability)])
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (((Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
 -> (Nullability, [(Text, Nullability)]))
-> Map
     Text
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
-> Map Text (Nullability, [(Text, Nullability)])
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(Nullability
r, [(Text, Nullability)]
p, String
_, Node (Lexeme Text)
_) -> (Nullability
r, [(Text, Nullability)]
p)) (ProgramDefs
-> Map
     Text
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
programFunctions ProgramDefs
pdefs)) (ProgramDefs -> Map Text (Nullability, [(Text, Nullability)])
programTypedefs ProgramDefs
pdefs)
                    initialState :: LinterState
initialState = TypeEnv
-> Map Text TypeEnv
-> Map Text (Nullability, [(Text, Nullability)])
-> String
-> Nullability
-> LinterState
LinterState TypeEnv
tenv (ProgramDefs -> Map Text TypeEnv
programStructs ProgramDefs
pdefs) Map Text (Nullability, [(Text, Nullability)])
fDefs String
file Nullability
retNull
                in StateT LinterState (State [Diagnostic CimplePos]) ()
-> LinterState -> StateT [Diagnostic CimplePos] Identity ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT (Node (Lexeme Text)
-> StateT LinterState (State [Diagnostic CimplePos]) ()
runAnalysis Node (Lexeme Text)
node) LinterState
initialState
            NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> StateT [Diagnostic CimplePos] Identity ()
act
    }

analyse :: [(FilePath, [C.Node (Lexeme Text)])] -> [Diagnostic CimplePos]
analyse :: [(String, [Node (Lexeme Text)])] -> [Diagnostic CimplePos]
analyse [(String, [Node (Lexeme Text)])]
input =
    let initialPdefs :: ProgramDefs
initialPdefs = Map Text TypeEnv
-> Map
     Text
     (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
-> TypeEnv
-> Map Text (Nullability, [(Text, Nullability)])
-> ProgramDefs
ProgramDefs Map Text TypeEnv
forall k a. Map k a
Map.empty Map
  Text
  (Nullability, [(Text, Nullability)], String, Node (Lexeme Text))
forall k a. Map k a
Map.empty TypeEnv
forall k a. Map k a
Map.empty Map Text (Nullability, [(Text, Nullability)])
forall k a. Map k a
Map.empty
        (ProgramDefs
pdefs, [Diagnostic CimplePos]
globalErrs) = State (ProgramDefs, [Diagnostic CimplePos]) ()
-> (ProgramDefs, [Diagnostic CimplePos])
-> (ProgramDefs, [Diagnostic CimplePos])
forall s a. State s a -> s -> s
State.execState (AstActions (State (ProgramDefs, [Diagnostic CimplePos])) Text
-> [(String, [Node (Lexeme Text)])]
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State (ProgramDefs, [Diagnostic CimplePos])) Text
collectDefs [(String, [Node (Lexeme Text)])]
input) (ProgramDefs
initialPdefs, [])
    in [Diagnostic CimplePos] -> [Diagnostic CimplePos]
forall a. [a] -> [a]
reverse ([Diagnostic CimplePos] -> [Diagnostic CimplePos])
-> ([(String, [Node (Lexeme Text)])] -> [Diagnostic CimplePos])
-> [(String, [Node (Lexeme Text)])]
-> [Diagnostic CimplePos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT [Diagnostic CimplePos] Identity ()
 -> [Diagnostic CimplePos] -> [Diagnostic CimplePos])
-> [Diagnostic CimplePos]
-> StateT [Diagnostic CimplePos] Identity ()
-> [Diagnostic CimplePos]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT [Diagnostic CimplePos] Identity ()
-> [Diagnostic CimplePos] -> [Diagnostic CimplePos]
forall s a. State s a -> s -> s
State.execState [Diagnostic CimplePos]
globalErrs (StateT [Diagnostic CimplePos] Identity ()
 -> [Diagnostic CimplePos])
-> ([(String, [Node (Lexeme Text)])]
    -> StateT [Diagnostic CimplePos] Identity ())
-> [(String, [Node (Lexeme Text)])]
-> [Diagnostic CimplePos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (State [Diagnostic CimplePos]) Text
-> [(String, [Node (Lexeme Text)])]
-> StateT [Diagnostic CimplePos] Identity ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst (ProgramDefs -> AstActions (State [Diagnostic CimplePos]) Text
linter ProgramDefs
pdefs) ([(String, [Node (Lexeme Text)])] -> [Diagnostic CimplePos])
-> [(String, [Node (Lexeme Text)])] -> [Diagnostic CimplePos]
forall a b. (a -> b) -> a -> b
$ [(String, [Node (Lexeme Text)])]
input

descr :: ([(FilePath, [C.Node (Lexeme Text)])] -> [Diagnostic CimplePos], (Text, Text))
descr :: ([(String, [Node (Lexeme Text)])] -> [Diagnostic CimplePos],
 (Text, Text))
descr = ([(String, [Node (Lexeme Text)])] -> [Diagnostic CimplePos]
analyse, (Text
"nullability", [Text] -> Text
Text.unlines
    [ Text
"Warns when a `_Nullable` pointer is cast to a `_Nonnull` pointer or dereferenced without a null check."
    , Text
""
    , Text
"**Reason:** Casting a nullable pointer to a non-null pointer or dereferencing it without ensuring it's not"
    , Text
"null can lead to null pointer dereferences and crashes."
    ]))