{-# 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 -> FilePath
(Int -> Nullability -> ShowS)
-> (Nullability -> FilePath)
-> ([Nullability] -> ShowS)
-> Show Nullability
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Nullability -> ShowS
showsPrec :: Int -> Nullability -> ShowS
$cshow :: Nullability -> FilePath
show :: Nullability -> FilePath
$cshowList :: [Nullability] -> ShowS
showList :: [Nullability] -> ShowS
Show, Nullability -> Nullability -> Bool
(Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Bool) -> Eq Nullability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Nullability -> Nullability -> Bool
== :: Nullability -> Nullability -> Bool
$c/= :: Nullability -> Nullability -> Bool
/= :: 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
$ccompare :: Nullability -> Nullability -> Ordering
compare :: Nullability -> Nullability -> Ordering
$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
>= :: Nullability -> Nullability -> Bool
$cmax :: Nullability -> Nullability -> Nullability
max :: Nullability -> Nullability -> Nullability
$cmin :: Nullability -> Nullability -> Nullability
min :: Nullability -> Nullability -> 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 -> FilePath
currentFile    :: FilePath
    , LinterState -> Nullability
currentFuncRet :: Nullability
    }

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

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

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

isPointerType :: C.Node (Lexeme Text) -> Bool
isPointerType :: Fix (NodeF (Lexeme Text)) -> Bool
isPointerType (Fix NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
node) = case NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
node of
    C.TyPointer Fix (NodeF (Lexeme Text))
_        -> Bool
True
    C.TyNullable Fix (NodeF (Lexeme Text))
t       -> Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Fix (NodeF (Lexeme Text))
t
    C.TyNonnull Fix (NodeF (Lexeme Text))
t        -> Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Fix (NodeF (Lexeme Text))
t
    C.TyConst Fix (NodeF (Lexeme Text))
t          -> Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Fix (NodeF (Lexeme Text))
t
    C.TyForce Fix (NodeF (Lexeme Text))
t          -> Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Fix (NodeF (Lexeme Text))
t
    C.VarDecl Fix (NodeF (Lexeme Text))
ty Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
specs -> Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Fix (NodeF (Lexeme Text))
ty Bool -> Bool -> Bool
|| (Fix (NodeF (Lexeme Text)) -> Bool)
-> [Fix (NodeF (Lexeme Text))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Fix (NodeF (Lexeme Text)) -> Bool
isArraySpec [Fix (NodeF (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) (Fix (NodeF (Lexeme Text)))
_                    -> Bool
False

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

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

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

getStructName :: C.Node (Lexeme Text) -> Maybe Text
getStructName :: Fix (NodeF (Lexeme Text)) -> Maybe Text
getStructName (Fix NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
node) = case NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
node of
    C.VarDecl Fix (NodeF (Lexeme Text))
ty Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
_               -> Fix (NodeF (Lexeme Text)) -> Maybe Text
getStructName Fix (NodeF (Lexeme Text))
ty
    C.TyPointer Fix (NodeF (Lexeme Text))
t                  -> Fix (NodeF (Lexeme Text)) -> Maybe Text
getStructName Fix (NodeF (Lexeme Text))
t
    C.TyConst Fix (NodeF (Lexeme Text))
t                    -> Fix (NodeF (Lexeme Text)) -> Maybe Text
getStructName Fix (NodeF (Lexeme Text))
t
    C.TyNonnull Fix (NodeF (Lexeme Text))
t                  -> Fix (NodeF (Lexeme Text)) -> Maybe Text
getStructName Fix (NodeF (Lexeme Text))
t
    C.TyNullable Fix (NodeF (Lexeme Text))
t                 -> Fix (NodeF (Lexeme Text)) -> Maybe Text
getStructName Fix (NodeF (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) (Fix (NodeF (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 FilePath
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 (FilePath -> Text
Text.pack FilePath
var) (LinterState -> TypeEnv
typeEnv LinterState
st)
    PathField AccessPath
base FilePath
member -> do
        Fix (NodeF (Lexeme Text))
baseType <- AccessPath -> LinterState -> Maybe (Fix (NodeF (Lexeme Text)))
getDeclaredType AccessPath
base LinterState
st
        case Fix (NodeF (Lexeme Text))
baseType of
            Fix (C.VarDecl Fix (NodeF (Lexeme Text))
ty Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
specs) | (Fix (NodeF (Lexeme Text)) -> Bool)
-> [Fix (NodeF (Lexeme Text))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Fix (NodeF (Lexeme Text)) -> Bool
isArraySpec [Fix (NodeF (Lexeme Text))]
specs ->
                Nullability -> Maybe Nullability
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Nullability -> Maybe Nullability)
-> Nullability -> Maybe Nullability
forall a b. (a -> b) -> a -> b
$ Fix (NodeF (Lexeme Text)) -> Nullability
getNullability' Fix (NodeF (Lexeme Text))
ty
            Fix (NodeF (Lexeme Text))
baseType' -> do
                Text
structName <- Fix (NodeF (Lexeme Text)) -> Maybe Text
getStructName Fix (NodeF (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 (FilePath -> Text
Text.pack FilePath
member) TypeEnv
structDef
    PathIndex AccessPath
base FilePath
_ -> do
        Fix (NodeF (Lexeme Text))
baseType <- AccessPath -> LinterState -> Maybe (Fix (NodeF (Lexeme Text)))
getDeclaredType AccessPath
base LinterState
st
        case Fix (NodeF (Lexeme Text))
baseType of
            Fix (C.VarDecl Fix (NodeF (Lexeme Text))
ty Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
_) -> Nullability -> Maybe Nullability
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Nullability -> Maybe Nullability)
-> Nullability -> Maybe Nullability
forall a b. (a -> b) -> a -> b
$ Fix (NodeF (Lexeme Text)) -> Nullability
getNullability' Fix (NodeF (Lexeme Text))
ty
            Fix (NodeF (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 (Fix (NodeF (Lexeme Text)))
getDeclaredType AccessPath
path LinterState
st = case AccessPath
path of
    PathVar FilePath
name -> VarInfo -> Maybe (Fix (NodeF (Lexeme Text)))
forall a b. (a, b) -> b
snd (VarInfo -> Maybe (Fix (NodeF (Lexeme Text))))
-> Maybe VarInfo -> Maybe (Fix (NodeF (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 (FilePath -> Text
Text.pack FilePath
name) (LinterState -> TypeEnv
typeEnv LinterState
st)
    PathField AccessPath
base FilePath
member -> do
        Fix (NodeF (Lexeme Text))
baseType <- AccessPath -> LinterState -> Maybe (Fix (NodeF (Lexeme Text)))
getDeclaredType AccessPath
base LinterState
st
        case Fix (NodeF (Lexeme Text))
baseType of
            Fix (C.VarDecl Fix (NodeF (Lexeme Text))
ty Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
specs) | (Fix (NodeF (Lexeme Text)) -> Bool)
-> [Fix (NodeF (Lexeme Text))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Fix (NodeF (Lexeme Text)) -> Bool
isArraySpec [Fix (NodeF (Lexeme Text))]
specs ->
                Fix (NodeF (Lexeme Text)) -> Maybe (Fix (NodeF (Lexeme Text)))
forall a. a -> Maybe a
Just Fix (NodeF (Lexeme Text))
ty
            Fix (NodeF (Lexeme Text))
baseType' -> do
                Text
structName <- Fix (NodeF (Lexeme Text)) -> Maybe Text
getStructName Fix (NodeF (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 (Fix (NodeF (Lexeme Text)))
forall a b. (a, b) -> b
snd (VarInfo -> Maybe (Fix (NodeF (Lexeme Text))))
-> Maybe VarInfo -> Maybe (Fix (NodeF (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 (FilePath -> Text
Text.pack FilePath
member) TypeEnv
structDef
    PathIndex AccessPath
base FilePath
_ -> do
        Fix (NodeF (Lexeme Text))
baseType <- AccessPath -> LinterState -> Maybe (Fix (NodeF (Lexeme Text)))
getDeclaredType AccessPath
base LinterState
st
        case Fix (NodeF (Lexeme Text))
baseType of
            Fix (C.VarDecl Fix (NodeF (Lexeme Text))
ty Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
_) -> Fix (NodeF (Lexeme Text)) -> Maybe (Fix (NodeF (Lexeme Text)))
forall a. a -> Maybe a
Just Fix (NodeF (Lexeme Text))
ty
            Fix (NodeF (Lexeme Text))
_                      -> Maybe (Fix (NodeF (Lexeme Text)))
forall a. Maybe a
Nothing
    AccessPath
_ -> Maybe (Fix (NodeF (Lexeme Text)))
forall a. Maybe a
Nothing

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

evaluate :: C.Node (Lexeme Text) -> S.SState -> S.SVal
evaluate :: Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate expr :: Fix (NodeF (Lexeme Text))
expr@(Fix NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
node) SState
st = case NodeF (Lexeme Text) (Fix (NodeF (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 (FilePath -> AccessPath
PathVar FilePath
"<string>")
    C.UnaryExpr UnaryOp
C.UopAddress Fix (NodeF (Lexeme Text))
e               -> case Fix (NodeF (Lexeme Text)) -> Maybe AccessPath
exprToPath Fix (NodeF (Lexeme Text))
e of
        Just AccessPath
p  -> AccessPath -> SVal
sAddr AccessPath
p
        Maybe AccessPath
Nothing -> SVal
S.STop
    C.ParenExpr Fix (NodeF (Lexeme Text))
e                            -> Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (Lexeme Text))
e SState
st
    C.CastExpr Fix (NodeF (Lexeme Text))
_ Fix (NodeF (Lexeme Text))
e                           -> Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (Lexeme Text))
e SState
st
    C.TernaryExpr Fix (NodeF (Lexeme Text))
cond Fix (NodeF (Lexeme Text))
thenBranch Fix (NodeF (Lexeme Text))
elseBranch ->
        let c :: SVal
c = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (Lexeme Text))
cond SState
st
            v1 :: SVal
v1 = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (Lexeme Text))
thenBranch SState
st
            v2 :: SVal
v2 = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (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 Fix (NodeF (Lexeme Text))
lhs BinaryOp
op Fix (NodeF (Lexeme Text))
rhs                  ->
        let v1 :: SVal
v1 = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (Lexeme Text))
lhs SState
st
            v2 :: SVal
v2 = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (Lexeme Text))
rhs SState
st
        in BinaryOp -> SVal -> SVal -> SVal
sBinOp BinaryOp
op SVal
v1 SVal
v2
    C.UnaryExpr UnaryOp
op Fix (NodeF (Lexeme Text))
e                         ->
        let v :: SVal
v = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (Lexeme Text))
e SState
st
        in UnaryOp -> SVal -> SVal
sUnaryOp UnaryOp
op SVal
v
    NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
_ -> case Fix (NodeF (Lexeme Text)) -> Maybe AccessPath
exprToPath Fix (NodeF (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
    { 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 Fix (NodeF (Lexeme Text))
stmt -> Fix (NodeF (Lexeme Text)) -> SState -> SState
transferStmt Fix (NodeF (Lexeme Text))
stmt SState
s
        NodeKind
_             -> SState
s

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

    edgeTransferFunc :: Node -> EdgeType -> SState -> SState
edgeTransferFunc (Node Int
_ (BranchNode Fix (NodeF (Lexeme Text))
cond)) EdgeType
branch SState
s =
        let v :: SVal
v = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (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 :: Fix (NodeF (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)
-> (Fix (NodeF (Lexeme Text)) -> State TypeEnv ())
-> Fix (NodeF (Lexeme Text))
-> TypeEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (StateT TypeEnv Identity) Text
-> Fix (NodeF (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 = \FilePath
_ Fix (NodeF (Lexeme Text))
node State TypeEnv ()
act -> case Fix (NodeF (Lexeme Text))
-> NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Fix (NodeF (Lexeme Text))
node of
            C.VarDecl Fix (NodeF (Lexeme Text))
_ (C.L AlexPosn
_ LexemeClass
_ Text
name) [Fix (NodeF (Lexeme Text))]
_ -> do
                let nullability :: Nullability
nullability = Fix (NodeF (Lexeme Text)) -> Nullability
getNullability' Fix (NodeF (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, Fix (NodeF (Lexeme Text)) -> Maybe (Fix (NodeF (Lexeme Text)))
forall a. a -> Maybe a
Just Fix (NodeF (Lexeme Text))
node)
                State TypeEnv ()
act
            NodeF (Lexeme Text) (Fix (NodeF (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 a. Eq a => a -> [a] -> 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 -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
st expr :: Fix (NodeF (Lexeme Text))
expr@(Fix NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
fixNode) = case NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
fixNode of
    C.TernaryExpr Fix (NodeF (Lexeme Text))
cond Fix (NodeF (Lexeme Text))
thenBranch Fix (NodeF (Lexeme Text))
elseBranch -> do
        SState
st' <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
st Fix (NodeF (Lexeme Text))
cond
        let v :: SVal
v = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (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 -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr (Constraint -> SState -> SState
S.addConstraint (SVal -> Constraint
S.SBool SVal
v) SState
st') Fix (NodeF (Lexeme Text))
thenBranch
        SState
stElse <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr (Constraint -> SState -> SState
S.addConstraint (Constraint -> Constraint
S.negateConstraint (SVal -> Constraint
S.SBool SVal
v)) SState
st') Fix (NodeF (Lexeme Text))
elseBranch
        SState -> LinterM SState
forall a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
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 Fix (NodeF (Lexeme Text))
lhs BinaryOp
BopAnd Fix (NodeF (Lexeme Text))
rhs -> do
        SState
st' <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
st Fix (NodeF (Lexeme Text))
lhs
        let v :: SVal
v = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (Lexeme Text))
lhs SState
st'
        SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr (Constraint -> SState -> SState
S.addConstraint (SVal -> Constraint
S.SBool SVal
v) SState
st') Fix (NodeF (Lexeme Text))
rhs

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

    C.CastExpr Fix (NodeF (Lexeme Text))
toType Fix (NodeF (Lexeme Text))
fromExpr -> do
        SState
st' <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
st Fix (NodeF (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 = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (Lexeme Text))
fromExpr SState
st'
        Bool
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Fix (NodeF (Lexeme Text)) -> Bool
isNonnull Fix (NodeF (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
$
             State [Diagnostic CimplePos] ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (m :: * -> *) a. Monad m => m a -> StateT LinterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (State [Diagnostic CimplePos] ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> State [Diagnostic CimplePos] ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> Fix (NodeF (Lexeme Text))
-> Doc AnsiStyle
-> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> FilePath
currentFile LinterState
lst) Fix (NodeF (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 (Fix (NodeF (Lexeme Text)) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Fix (NodeF (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 a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SState -> LinterM SState) -> SState -> LinterM SState
forall a b. (a -> b) -> a -> b
$ if Fix (NodeF (Lexeme Text)) -> Bool
isNonnull Fix (NodeF (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 Fix (NodeF (Lexeme Text))
e Lexeme Text
_ -> do
        SState
st' <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
st Fix (NodeF (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 = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (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
$
            State [Diagnostic CimplePos] ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (m :: * -> *) a. Monad m => m a -> StateT LinterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (State [Diagnostic CimplePos] ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> State [Diagnostic CimplePos] ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> Fix (NodeF (Lexeme Text))
-> Doc AnsiStyle
-> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> FilePath
currentFile LinterState
lst) Fix (NodeF (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 (Fix (NodeF (Lexeme Text)) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Fix (NodeF (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 a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
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 Fix (NodeF (Lexeme Text))
e Fix (NodeF (Lexeme Text))
_ -> do
        SState
st' <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
st Fix (NodeF (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 = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (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
$
            State [Diagnostic CimplePos] ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (m :: * -> *) a. Monad m => m a -> StateT LinterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (State [Diagnostic CimplePos] ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> State [Diagnostic CimplePos] ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> Fix (NodeF (Lexeme Text))
-> Doc AnsiStyle
-> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> FilePath
currentFile LinterState
lst) Fix (NodeF (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 (Fix (NodeF (Lexeme Text)) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Fix (NodeF (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 a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
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 Fix (NodeF (Lexeme Text))
e -> do
        SState
st' <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
st Fix (NodeF (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 = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (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
$
            State [Diagnostic CimplePos] ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (m :: * -> *) a. Monad m => m a -> StateT LinterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (State [Diagnostic CimplePos] ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> State [Diagnostic CimplePos] ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> Fix (NodeF (Lexeme Text))
-> Doc AnsiStyle
-> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> FilePath
currentFile LinterState
lst) Fix (NodeF (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 (Fix (NodeF (Lexeme Text)) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Fix (NodeF (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 a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
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 Fix (NodeF (Lexeme Text))
funcExpr [Fix (NodeF (Lexeme Text))]
args -> do
        SState
st' <- (SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState)
-> SState -> [Fix (NodeF (Lexeme Text))] -> LinterM SState
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
st (Fix (NodeF (Lexeme Text))
funcExpr Fix (NodeF (Lexeme Text))
-> [Fix (NodeF (Lexeme Text))] -> [Fix (NodeF (Lexeme Text))]
forall a. a -> [a] -> [a]
: [Fix (NodeF (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 Fix (NodeF (Lexeme Text)) -> Maybe Text
getFuncName Fix (NodeF (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 Fix (NodeF (Lexeme Text)) -> Maybe AccessPath
exprToPath Fix (NodeF (Lexeme Text))
funcExpr of
                    Just AccessPath
path -> case AccessPath -> LinterState -> Maybe (Fix (NodeF (Lexeme Text)))
getDeclaredType AccessPath
path LinterState
lst of
                        Just (Fix (C.VarDecl Fix (NodeF (Lexeme Text))
ty Lexeme Text
_ [Fix (NodeF (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 Fix (NodeF (Lexeme Text)) -> Maybe Text
forall {a}. Fix (NodeF (Lexeme a)) -> Maybe a
getTypeName Fix (NodeF (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 (Fix (NodeF (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) ->
                [(Fix (NodeF (Lexeme Text)), (Text, Nullability))]
-> ((Fix (NodeF (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_ ([Fix (NodeF (Lexeme Text))]
-> [(Text, Nullability)]
-> [(Fix (NodeF (Lexeme Text)), (Text, Nullability))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Fix (NodeF (Lexeme Text))]
args [(Text, Nullability)]
paramNullabilities) (((Fix (NodeF (Lexeme Text)), (Text, Nullability))
  -> StateT LinterState (State [Diagnostic CimplePos]) ())
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> ((Fix (NodeF (Lexeme Text)), (Text, Nullability))
    -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a b. (a -> b) -> a -> b
$ \(Fix (NodeF (Lexeme Text))
arg, (Text
_, Nullability
paramNullability)) ->
                    let v :: SVal
v = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (Lexeme Text))
arg SState
st'
                        -- Don't warn again if it's a non-null cast (CastExpr already warned)
                        isCastToNonnull :: Bool
isCastToNonnull = case Fix (NodeF (Lexeme Text))
-> NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Fix (NodeF (Lexeme Text))
arg of
                            C.CastExpr Fix (NodeF (Lexeme Text))
ty Fix (NodeF (Lexeme Text))
_ -> Fix (NodeF (Lexeme Text)) -> Bool
isNonnull Fix (NodeF (Lexeme Text))
ty
                            NodeF (Lexeme Text) (Fix (NodeF (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
$
                        State [Diagnostic CimplePos] ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (m :: * -> *) a. Monad m => m a -> StateT LinterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (State [Diagnostic CimplePos] ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> State [Diagnostic CimplePos] ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> Fix (NodeF (Lexeme Text))
-> Doc AnsiStyle
-> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> FilePath
currentFile LinterState
lst) Fix (NodeF (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 (Fix (NodeF (Lexeme Text)) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Fix (NodeF (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 a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

    C.AssignExpr Fix (NodeF (Lexeme Text))
lhs AssignOp
op Fix (NodeF (Lexeme Text))
rhs -> do
        SState
st' <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
st Fix (NodeF (Lexeme Text))
lhs
        SState
st'' <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
st' Fix (NodeF (Lexeme Text))
rhs
        LinterState
lst <- StateT LinterState (State [Diagnostic CimplePos]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        case (AssignOp
op, Fix (NodeF (Lexeme Text)) -> Maybe AccessPath
exprToPath Fix (NodeF (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 = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (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
$
                    State [Diagnostic CimplePos] ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (m :: * -> *) a. Monad m => m a -> StateT LinterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (State [Diagnostic CimplePos] ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> State [Diagnostic CimplePos] ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> Fix (NodeF (Lexeme Text))
-> Doc AnsiStyle
-> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> FilePath
currentFile LinterState
lst) Fix (NodeF (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 (Fix (NodeF (Lexeme Text)) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Fix (NodeF (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 a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
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 a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
forall (m :: * -> *) a. Monad m => a -> m a
return SState
st''

    C.BinaryExpr Fix (NodeF (Lexeme Text))
lhs BinaryOp
op Fix (NodeF (Lexeme Text))
rhs | BinaryOp
op BinaryOp -> [BinaryOp] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BinaryOp
BopPlus, BinaryOp
BopMinus] -> do
        SState
st' <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
st Fix (NodeF (Lexeme Text))
lhs
        SState
st'' <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
st' Fix (NodeF (Lexeme Text))
rhs
        LinterState
lst <- StateT LinterState (State [Diagnostic CimplePos]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        let check :: Fix (NodeF (Lexeme Text)) -> SState -> t (StateT diags Identity) ()
check Fix (NodeF (Lexeme Text))
e SState
s = case (Fix (NodeF (Lexeme Text)) -> Maybe AccessPath
exprToPath Fix (NodeF (Lexeme Text))
e, Fix (NodeF (Lexeme Text)) -> Maybe AccessPath
exprToPath Fix (NodeF (Lexeme Text))
e Maybe AccessPath
-> (AccessPath -> Maybe (Fix (NodeF (Lexeme Text))))
-> Maybe (Fix (NodeF (Lexeme Text)))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AccessPath -> LinterState -> Maybe (Fix (NodeF (Lexeme Text)))
`getDeclaredType` LinterState
lst)) of
                (Just AccessPath
_, Just Fix (NodeF (Lexeme Text))
ty) | Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Fix (NodeF (Lexeme Text))
ty ->
                    let v :: SVal
v = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (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 (m :: * -> *) a. Monad m => m a -> t m a
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
. FilePath
-> Fix (NodeF (Lexeme Text))
-> Doc AnsiStyle
-> StateT diags Identity ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> FilePath
currentFile LinterState
lst) Fix (NodeF (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 (Fix (NodeF (Lexeme Text)) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Fix (NodeF (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 (Fix (NodeF (Lexeme Text))))
_ -> () -> t (StateT diags Identity) ()
forall a. a -> t (StateT diags Identity) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Fix (NodeF (Lexeme Text))
-> SState -> StateT LinterState (State [Diagnostic CimplePos]) ()
forall {t :: (* -> *) -> * -> *} {diags}.
(MonadTrans t, HasDiagnosticsRich diags CimplePos,
 Monad (t (StateT diags Identity))) =>
Fix (NodeF (Lexeme Text)) -> SState -> t (StateT diags Identity) ()
check Fix (NodeF (Lexeme Text))
lhs SState
st''
        Fix (NodeF (Lexeme Text))
-> SState -> StateT LinterState (State [Diagnostic CimplePos]) ()
forall {t :: (* -> *) -> * -> *} {diags}.
(MonadTrans t, HasDiagnosticsRich diags CimplePos,
 Monad (t (StateT diags Identity))) =>
Fix (NodeF (Lexeme Text)) -> SState -> t (StateT diags Identity) ()
check Fix (NodeF (Lexeme Text))
rhs SState
st''
        SState -> LinterM SState
forall a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
forall (m :: * -> *) a. Monad m => a -> m a
return SState
st''

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

data ProgramDefs = ProgramDefs
    { ProgramDefs -> Map Text TypeEnv
programStructs   :: Map Text TypeEnv
    , ProgramDefs
-> Map
     Text
     (Nullability, [(Text, Nullability)], FilePath,
      Fix (NodeF (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 a. [a] -> 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 a. [a] -> 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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Nullability)]
p1) ([(Text, Nullability)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Nullability)]
p2)
    (Nullability, [(Text, Nullability)])
-> Either Mismatch (Nullability, [(Text, Nullability)])
forall a. a -> Either Mismatch a
forall (m :: * -> *) a. Monad m => a -> m a
return (Nullability
r, [(Text, Nullability)]
p)

getParams :: C.Node (Lexeme Text) -> [C.Node (Lexeme Text)]
getParams :: Fix (NodeF (Lexeme Text)) -> [Fix (NodeF (Lexeme Text))]
getParams (Fix (C.FunctionPrototype Fix (NodeF (Lexeme Text))
_ Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
ps)) = [Fix (NodeF (Lexeme Text))]
ps
getParams Fix (NodeF (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 = \FilePath
file Fix (NodeF (Lexeme Text))
node State (ProgramDefs, [Diagnostic CimplePos]) ()
act ->
        case Fix (NodeF (Lexeme Text))
-> NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Fix (NodeF (Lexeme Text))
node of
            C.Typedef (Fix (C.Struct Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
members)) Lexeme Text
structName [Fix (NodeF (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)
-> ([Fix (NodeF (Lexeme Text))] -> [(Text, VarInfo)])
-> [Fix (NodeF (Lexeme Text))]
-> TypeEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fix (NodeF (Lexeme Text)) -> [(Text, VarInfo)])
-> [Fix (NodeF (Lexeme Text))] -> [(Text, VarInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Fix (NodeF (Lexeme Text)) -> [(Text, VarInfo)]
getFieldDecls ([Fix (NodeF (Lexeme Text))] -> TypeEnv)
-> [Fix (NodeF (Lexeme Text))] -> TypeEnv
forall a b. (a -> b) -> a -> b
$ [Fix (NodeF (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.insert (C.lexemeText structName) fieldEnv (programStructs s) }, [Diagnostic CimplePos]
errs)
                State (ProgramDefs, [Diagnostic CimplePos]) ()
act
            C.TypedefFunction Fix (NodeF (Lexeme Text))
proto -> do
                case Fix (NodeF (Lexeme Text)) -> Maybe Text
forall a. Show a => Node (Lexeme a) -> Maybe a
functionName Fix (NodeF (Lexeme Text))
proto of
                    Just Text
name -> do
                        let (Fix (C.FunctionPrototype Fix (NodeF (Lexeme Text))
retType Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
params)) = Fix (NodeF (Lexeme Text))
proto
                        let retNullability :: Nullability
retNullability = Fix (NodeF (Lexeme Text)) -> Nullability
getNullability' Fix (NodeF (Lexeme Text))
retType
                        let paramInfos :: [(Text, Nullability)]
paramInfos = (Fix (NodeF (Lexeme Text)) -> (Text, Nullability))
-> [Fix (NodeF (Lexeme Text))] -> [(Text, Nullability)]
forall a b. (a -> b) -> [a] -> [b]
map Fix (NodeF (Lexeme Text)) -> (Text, Nullability)
getParamInfo [Fix (NodeF (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.insert name (retNullability, paramInfos) (programTypedefs s) }, [Diagnostic CimplePos]
errs)
                    Maybe Text
Nothing -> () -> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall a. a -> State (ProgramDefs, [Diagnostic CimplePos]) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                State (ProgramDefs, [Diagnostic CimplePos]) ()
act
            C.FunctionPrototype Fix (NodeF (Lexeme Text))
retType (C.L AlexPosn
_ LexemeClass
_ Text
name) [Fix (NodeF (Lexeme Text))]
params -> do
                let retNullability :: Nullability
retNullability = Fix (NodeF (Lexeme Text)) -> Nullability
getNullability' Fix (NodeF (Lexeme Text))
retType
                let currentParamInfos :: [(Text, Nullability)]
currentParamInfos = (Fix (NodeF (Lexeme Text)) -> (Text, Nullability))
-> [Fix (NodeF (Lexeme Text))] -> [(Text, Nullability)]
forall a b. (a -> b) -> [a] -> [b]
map Fix (NodeF (Lexeme Text)) -> (Text, Nullability)
getParamInfo [Fix (NodeF (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)], FilePath,
      Fix (NodeF (Lexeme Text)))
-> Maybe
     (Nullability, [(Text, Nullability)], FilePath,
      Fix (NodeF (Lexeme Text)))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name (ProgramDefs
-> Map
     Text
     (Nullability, [(Text, Nullability)], FilePath,
      Fix (NodeF (Lexeme Text)))
programFunctions ProgramDefs
s) of
                    Maybe
  (Nullability, [(Text, Nullability)], FilePath,
   Fix (NodeF (Lexeme Text)))
Nothing ->
                        (ProgramDefs, [Diagnostic CimplePos])
-> State (ProgramDefs, [Diagnostic CimplePos]) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (ProgramDefs
s { programFunctions = Map.insert name (retNullability, currentParamInfos, file, node) (programFunctions s) }, [Diagnostic CimplePos]
errs)
                    Just (Nullability
oldRet, [(Text, Nullability)]
oldParamInfos, FilePath
oldFile, Fix (NodeF (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.insert name (newRet, newParamInfos, oldFile, node) (programFunctions s) }, [Diagnostic CimplePos]
errs)
                            Left Mismatch
mismatch -> do
                                let (CimplePos
pos, Int
len) = FilePath -> Fix (NodeF (Lexeme Text)) -> (CimplePos, Int)
nodePosAndLen FilePath
file Fix (NodeF (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 ann. Text -> Doc ann
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
$ FilePath -> Fix (NodeF (Lexeme Text)) -> (CimplePos, Int)
nodePosAndLen FilePath
oldFile Fix (NodeF (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
$ FilePath -> Fix (NodeF (Lexeme Text)) -> (CimplePos, Int)
nodePosAndLen FilePath
oldFile Fix (NodeF (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 :: Fix (NodeF (Lexeme Text))
oldParam = Fix (NodeF (Lexeme Text)) -> [Fix (NodeF (Lexeme Text))]
getParams Fix (NodeF (Lexeme Text))
oldNode [Fix (NodeF (Lexeme Text))] -> Int -> Fix (NodeF (Lexeme Text))
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
                                                newParam :: Fix (NodeF (Lexeme Text))
newParam = [Fix (NodeF (Lexeme Text))]
params [Fix (NodeF (Lexeme Text))] -> Int -> Fix (NodeF (Lexeme Text))
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
                                                (CimplePos
oldPos, Int
oldLen) = FilePath -> Fix (NodeF (Lexeme Text)) -> (CimplePos, Int)
nodePosAndLen FilePath
oldFile Fix (NodeF (Lexeme Text))
oldParam
                                                (CimplePos
newPos, Int
newLen) = FilePath -> Fix (NodeF (Lexeme Text)) -> (CimplePos, Int)
nodePosAndLen FilePath
file Fix (NodeF (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 ann. Int -> Doc ann
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 ann. Text -> Doc ann
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 ann. Text -> Doc ann
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 ann. Text -> Doc ann
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
$ FilePath -> Fix (NodeF (Lexeme Text)) -> (CimplePos, Int)
nodePosAndLen FilePath
oldFile Fix (NodeF (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
$ FilePath -> Fix (NodeF (Lexeme Text)) -> (CimplePos, Int)
nodePosAndLen FilePath
oldFile Fix (NodeF (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 Fix (NodeF (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 = Map.insert name (getNullability' ty, Just ty) (programGlobals s) }, [Diagnostic CimplePos]
errs)
                State (ProgramDefs, [Diagnostic CimplePos]) ()
act
            C.ConstDefn Scope
_ Fix (NodeF (Lexeme Text))
ty (C.L AlexPosn
_ LexemeClass
_ Text
name) Fix (NodeF (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 = Map.insert name (getNullability' ty, Just ty) (programGlobals s) }, [Diagnostic CimplePos]
errs)
                State (ProgramDefs, [Diagnostic CimplePos]) ()
act
            NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
_ -> State (ProgramDefs, [Diagnostic CimplePos]) ()
act
    }
  where
    getFieldDecls :: Fix (NodeF (Lexeme Text)) -> [(Text, VarInfo)]
getFieldDecls (Fix (C.MemberDecl (Fix (C.VarDecl Fix (NodeF (Lexeme Text))
ty Lexeme Text
name [Fix (NodeF (Lexeme Text))]
_)) Maybe (Lexeme Text)
_)) =
        [(Lexeme Text -> Text
forall text. Lexeme text -> text
C.lexemeText Lexeme Text
name, (Fix (NodeF (Lexeme Text)) -> Nullability
getNullability' Fix (NodeF (Lexeme Text))
ty, Fix (NodeF (Lexeme Text)) -> Maybe (Fix (NodeF (Lexeme Text)))
forall a. a -> Maybe a
Just Fix (NodeF (Lexeme Text))
ty))]
    getFieldDecls Fix (NodeF (Lexeme Text))
_ = []

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

runAnalysis :: C.Node (Lexeme Text) -> LinterM ()
runAnalysis :: Fix (NodeF (Lexeme Text))
-> StateT LinterState (State [Diagnostic CimplePos]) ()
runAnalysis defn :: Fix (NodeF (Lexeme Text))
defn@(Fix (C.FunctionDefn Scope
_ Fix (NodeF (Lexeme Text))
proto Fix (NodeF (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 = Fix (NodeF (Lexeme Text)) -> TypeEnv
collectTypeEnv Fix (NodeF (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 = tenv }
    let (Node
entry, CFG
cfg) = Fix (NodeF (Lexeme Text)) -> (Node, CFG)
fromFunction Fix (NodeF (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 Fix (NodeF (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 -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseAtomicStmt SState
s Fix (NodeF (Lexeme Text))
stmt
            Node Int
_ (BranchNode Fix (NodeF (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 -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
s Fix (NodeF (Lexeme Text))
cond
            Node
_ -> () -> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
runAnalysis Fix (NodeF (Lexeme Text))
_ = () -> StateT LinterState (State [Diagnostic CimplePos]) ()
forall a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

analyseAtomicStmt :: S.SState -> C.Node (Lexeme Text) -> LinterM S.SState
analyseAtomicStmt :: SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseAtomicStmt SState
s (Fix NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
node) = case NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
node of
    C.ExprStmt Fix (NodeF (Lexeme Text))
e -> SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
s Fix (NodeF (Lexeme Text))
e
    C.VarDeclStmt (Fix (C.VarDecl Fix (NodeF (Lexeme Text))
ty (C.L AlexPosn
_ LexemeClass
_ Text
name) [Fix (NodeF (Lexeme Text))]
_)) (Just Fix (NodeF (Lexeme Text))
i) -> do
        SState
s' <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
s Fix (NodeF (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 = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (Lexeme Text))
i SState
s'
            path :: AccessPath
path = FilePath -> AccessPath
PathVar (Text -> FilePath
Text.unpack Text
name)
        Bool
-> StateT LinterState (State [Diagnostic CimplePos]) ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Fix (NodeF (Lexeme Text)) -> Nullability
getNullability' Fix (NodeF (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
$
            State [Diagnostic CimplePos] ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (m :: * -> *) a. Monad m => m a -> StateT LinterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (State [Diagnostic CimplePos] ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> State [Diagnostic CimplePos] ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> Fix (NodeF (Lexeme Text))
-> Doc AnsiStyle
-> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> FilePath
currentFile LinterState
lst) Fix (NodeF (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 (Fix (NodeF (Lexeme Text)) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Fix (NodeF (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 a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SState -> LinterM SState) -> SState -> LinterM SState
forall a b. (a -> b) -> a -> b
$ if Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Fix (NodeF (Lexeme Text))
ty then AccessPath -> SVal -> SState -> SState
S.assign AccessPath
path SVal
v SState
s' else SState
s'
    C.Return (Just Fix (NodeF (Lexeme Text))
e) -> do
        SState
s' <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
s Fix (NodeF (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 = Fix (NodeF (Lexeme Text)) -> SState -> SVal
evaluate Fix (NodeF (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
$
            State [Diagnostic CimplePos] ()
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall (m :: * -> *) a. Monad m => m a -> StateT LinterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (State [Diagnostic CimplePos] ()
 -> StateT LinterState (State [Diagnostic CimplePos]) ())
-> (Doc AnsiStyle -> State [Diagnostic CimplePos] ())
-> Doc AnsiStyle
-> StateT LinterState (State [Diagnostic CimplePos]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> Fix (NodeF (Lexeme Text))
-> Doc AnsiStyle
-> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc (LinterState -> FilePath
currentFile LinterState
lst) Fix (NodeF (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 (Fix (NodeF (Lexeme Text)) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Fix (NodeF (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 a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
forall (m :: * -> *) a. Monad m => a -> m a
return SState
s'
    C.IfStmt Fix (NodeF (Lexeme Text))
cond Fix (NodeF (Lexeme Text))
_ Maybe (Fix (NodeF (Lexeme Text)))
_ -> SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
s Fix (NodeF (Lexeme Text))
cond
    C.WhileStmt Fix (NodeF (Lexeme Text))
cond Fix (NodeF (Lexeme Text))
_ -> SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
s Fix (NodeF (Lexeme Text))
cond
    C.DoWhileStmt Fix (NodeF (Lexeme Text))
_ Fix (NodeF (Lexeme Text))
cond -> SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
s Fix (NodeF (Lexeme Text))
cond
    C.ForStmt Fix (NodeF (Lexeme Text))
init' Fix (NodeF (Lexeme Text))
cond Fix (NodeF (Lexeme Text))
step Fix (NodeF (Lexeme Text))
_ -> do
        SState
s' <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
s Fix (NodeF (Lexeme Text))
init'
        SState
s'' <- SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
s' Fix (NodeF (Lexeme Text))
cond
        SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
s'' Fix (NodeF (Lexeme Text))
step
    C.SwitchStmt Fix (NodeF (Lexeme Text))
expr [Fix (NodeF (Lexeme Text))]
_ -> SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
s Fix (NodeF (Lexeme Text))
expr
    C.Case Fix (NodeF (Lexeme Text))
expr Fix (NodeF (Lexeme Text))
_ -> SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
s Fix (NodeF (Lexeme Text))
expr
    C.Label Lexeme Text
_ Fix (NodeF (Lexeme Text))
_ -> SState -> LinterM SState
forall a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
forall (m :: * -> *) a. Monad m => a -> m a
return SState
s -- Body analyzed as its own node
    C.PreprocIf Fix (NodeF (Lexeme Text))
cond [Fix (NodeF (Lexeme Text))]
_ Fix (NodeF (Lexeme Text))
_ -> SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
s Fix (NodeF (Lexeme Text))
cond
    C.PreprocIfdef Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
_ Fix (NodeF (Lexeme Text))
_ -> SState -> LinterM SState
forall a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
forall (m :: * -> *) a. Monad m => a -> m a
return SState
s -- Identifier is atomic
    C.PreprocIfndef Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
_ Fix (NodeF (Lexeme Text))
_ -> SState -> LinterM SState
forall a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
forall (m :: * -> *) a. Monad m => a -> m a
return SState
s -- Identifier is atomic
    C.PreprocElif Fix (NodeF (Lexeme Text))
cond [Fix (NodeF (Lexeme Text))]
_ Fix (NodeF (Lexeme Text))
_ -> SState -> Fix (NodeF (Lexeme Text)) -> LinterM SState
analyseExpr SState
s Fix (NodeF (Lexeme Text))
cond
    NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
_ -> SState -> LinterM SState
forall a. a -> StateT LinterState (State [Diagnostic CimplePos]) a
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 = \FilePath
file Fix (NodeF (Lexeme Text))
node State [Diagnostic CimplePos] ()
act ->
        case Fix (NodeF (Lexeme Text))
-> NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Fix (NodeF (Lexeme Text))
node of
            C.FunctionDefn Scope
_ proto :: Fix (NodeF (Lexeme Text))
proto@(Fix (C.FunctionPrototype Fix (NodeF (Lexeme Text))
retType (C.L AlexPosn
_ LexemeClass
_ Text
name) [Fix (NodeF (Lexeme Text))]
_)) Fix (NodeF (Lexeme Text))
_ ->
                let localParams :: [(Text, VarInfo)]
localParams = Fix (NodeF (Lexeme Text)) -> [(Text, VarInfo)]
getParamTypes Fix (NodeF (Lexeme Text))
proto
                    (Nullability
retNull, [(Text, VarInfo)]
mergedParamsInfo) = case Text
-> Map
     Text
     (Nullability, [(Text, Nullability)], FilePath,
      Fix (NodeF (Lexeme Text)))
-> Maybe
     (Nullability, [(Text, Nullability)], FilePath,
      Fix (NodeF (Lexeme Text)))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name (ProgramDefs
-> Map
     Text
     (Nullability, [(Text, Nullability)], FilePath,
      Fix (NodeF (Lexeme Text)))
programFunctions ProgramDefs
pdefs) of
                        Just (Nullability
r, [(Text, Nullability)]
mergedParams, FilePath
_, Fix (NodeF (Lexeme Text))
_) | [(Text, Nullability)] -> Int
forall a. [a] -> 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 a. [a] -> 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 (Fix (NodeF (Lexeme Text)))
ty)) (Text
_, Nullability
m) -> (Text
n, (Nullability
m, Maybe (Fix (NodeF (Lexeme Text)))
ty))) [(Text, VarInfo)]
localParams [(Text, Nullability)]
mergedParams)
                        Maybe
  (Nullability, [(Text, Nullability)], FilePath,
   Fix (NodeF (Lexeme Text)))
_ -> (Fix (NodeF (Lexeme Text)) -> Nullability
getNullability' Fix (NodeF (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)], FilePath,
  Fix (NodeF (Lexeme Text)))
 -> (Nullability, [(Text, Nullability)]))
-> Map
     Text
     (Nullability, [(Text, Nullability)], FilePath,
      Fix (NodeF (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, FilePath
_, Fix (NodeF (Lexeme Text))
_) -> (Nullability
r, [(Text, Nullability)]
p)) (ProgramDefs
-> Map
     Text
     (Nullability, [(Text, Nullability)], FilePath,
      Fix (NodeF (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)])
-> FilePath
-> Nullability
-> LinterState
LinterState TypeEnv
tenv (ProgramDefs -> Map Text TypeEnv
programStructs ProgramDefs
pdefs) Map Text (Nullability, [(Text, Nullability)])
fDefs FilePath
file Nullability
retNull
                in StateT LinterState (State [Diagnostic CimplePos]) ()
-> LinterState -> State [Diagnostic CimplePos] ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT (Fix (NodeF (Lexeme Text))
-> StateT LinterState (State [Diagnostic CimplePos]) ()
runAnalysis Fix (NodeF (Lexeme Text))
node) LinterState
initialState
            NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
_ -> State [Diagnostic CimplePos] ()
act
    }

analyse :: [(FilePath, [C.Node (Lexeme Text)])] -> [Diagnostic CimplePos]
analyse :: [(FilePath, [Fix (NodeF (Lexeme Text))])] -> [Diagnostic CimplePos]
analyse [(FilePath, [Fix (NodeF (Lexeme Text))])]
input =
    let initialPdefs :: ProgramDefs
initialPdefs = Map Text TypeEnv
-> Map
     Text
     (Nullability, [(Text, Nullability)], FilePath,
      Fix (NodeF (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)], FilePath,
   Fix (NodeF (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
-> [(FilePath, [Fix (NodeF (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 [(FilePath, [Fix (NodeF (Lexeme Text))])]
input) (ProgramDefs
initialPdefs, [])
    in [Diagnostic CimplePos] -> [Diagnostic CimplePos]
forall a. [a] -> [a]
reverse ([Diagnostic CimplePos] -> [Diagnostic CimplePos])
-> ([(FilePath, [Fix (NodeF (Lexeme Text))])]
    -> [Diagnostic CimplePos])
-> [(FilePath, [Fix (NodeF (Lexeme Text))])]
-> [Diagnostic CimplePos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State [Diagnostic CimplePos] ()
 -> [Diagnostic CimplePos] -> [Diagnostic CimplePos])
-> [Diagnostic CimplePos]
-> State [Diagnostic CimplePos] ()
-> [Diagnostic CimplePos]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State [Diagnostic CimplePos] ()
-> [Diagnostic CimplePos] -> [Diagnostic CimplePos]
forall s a. State s a -> s -> s
State.execState [Diagnostic CimplePos]
globalErrs (State [Diagnostic CimplePos] () -> [Diagnostic CimplePos])
-> ([(FilePath, [Fix (NodeF (Lexeme Text))])]
    -> State [Diagnostic CimplePos] ())
-> [(FilePath, [Fix (NodeF (Lexeme Text))])]
-> [Diagnostic CimplePos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (State [Diagnostic CimplePos]) Text
-> [(FilePath, [Fix (NodeF (Lexeme Text))])]
-> State [Diagnostic CimplePos] ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst (ProgramDefs -> AstActions (State [Diagnostic CimplePos]) Text
linter ProgramDefs
pdefs) ([(FilePath, [Fix (NodeF (Lexeme Text))])]
 -> [Diagnostic CimplePos])
-> [(FilePath, [Fix (NodeF (Lexeme Text))])]
-> [Diagnostic CimplePos]
forall a b. (a -> b) -> a -> b
$ [(FilePath, [Fix (NodeF (Lexeme Text))])]
input

descr :: ([(FilePath, [C.Node (Lexeme Text)])] -> [Diagnostic CimplePos], (Text, Text))
descr :: ([(FilePath, [Fix (NodeF (Lexeme Text))])]
 -> [Diagnostic CimplePos],
 (Text, Text))
descr = ([(FilePath, [Fix (NodeF (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."
    ]))