{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE Strict            #-}
{-# LANGUAGE TemplateHaskell   #-}
module Tokstyle.Linter.VarUnusedInScope (descr) where

import           Control.Applicative         ((<|>))
import           Control.Monad.State.Strict  (State)
import qualified Control.Monad.State.Strict  as State
import           Data.Fix                    (Fix (..), foldFix)
import           Data.List                   (isSuffixOf)
import           Data.Map.Strict             (Map)
import qualified Data.Map.Strict             as Map
import           Data.Text                   (Text)
import qualified Data.Text                   as Text
--import           Debug.Trace                 (trace)
import           Language.Cimple             (AssignOp (..), Lexeme (..), Node,
                                              NodeF (..), UnaryOp (..),
                                              lexemeText)
import           Language.Cimple.Diagnostics (warn)
import           Language.Cimple.TraverseAst (AstActions, astActions, doNode,
                                              traverseAst)
import           Lens.Micro                  (over, set, (^.))
import           Lens.Micro.TH               (makeLenses, makeLensesFor)
import           Text.Groom                  (groom)
import qualified Tokstyle.Common             as Common


data Action
    = NoReduce
    | Reduce
    | Declare
    | Read
    | Write
    | ReadWrite
    deriving (Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
(Int -> Action -> ShowS)
-> (Action -> String) -> ([Action] -> ShowS) -> Show Action
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show, Action -> Action -> Bool
(Action -> Action -> Bool)
-> (Action -> Action -> Bool) -> Eq Action
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c== :: Action -> Action -> Bool
Eq, Eq Action
Eq Action
-> (Action -> Action -> Ordering)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Action)
-> (Action -> Action -> Action)
-> Ord Action
Action -> Action -> Bool
Action -> Action -> Ordering
Action -> Action -> Action
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Action -> Action -> Action
$cmin :: Action -> Action -> Action
max :: Action -> Action -> Action
$cmax :: Action -> Action -> Action
>= :: Action -> Action -> Bool
$c>= :: Action -> Action -> Bool
> :: Action -> Action -> Bool
$c> :: Action -> Action -> Bool
<= :: Action -> Action -> Bool
$c<= :: Action -> Action -> Bool
< :: Action -> Action -> Bool
$c< :: Action -> Action -> Bool
compare :: Action -> Action -> Ordering
$ccompare :: Action -> Action -> Ordering
$cp1Ord :: Eq Action
Ord)

data Flags = Flags
    { Flags -> Bool
_flgIndirect    :: Bool
      -- ^ A variable read within a more complex expression. All variable references start out with
      -- "potential write". On the LHS of an assignment, all direct variable references are turned
      -- into Write operations. Indirect means, the variable reference was part of an expression
      -- that makes it a pure read, so doesn't turn it into a write. Example: `*a = 3`, where `a` is
      -- not assigned.
    , Flags -> Bool
_flgConditional :: Bool
    , Flags -> Bool
_flgLoop        :: Bool
    , Flags -> Bool
_flgNonConst    :: Bool
      -- ^ Whether an expression contains any non-constant expressions.
    , Flags -> Int
_flgNested      :: Int
    }
    deriving (Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> String
(Int -> Flags -> ShowS)
-> (Flags -> String) -> ([Flags] -> ShowS) -> Show Flags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flags] -> ShowS
$cshowList :: [Flags] -> ShowS
show :: Flags -> String
$cshow :: Flags -> String
showsPrec :: Int -> Flags -> ShowS
$cshowsPrec :: Int -> Flags -> ShowS
Show, Flags -> Flags -> Bool
(Flags -> Flags -> Bool) -> (Flags -> Flags -> Bool) -> Eq Flags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flags -> Flags -> Bool
$c/= :: Flags -> Flags -> Bool
== :: Flags -> Flags -> Bool
$c== :: Flags -> Flags -> Bool
Eq)

makeLenses ''Flags

andFlags :: Flags -> Flags -> Flags
Flags
a andFlags :: Flags -> Flags -> Flags
`andFlags` Flags
b = Bool -> Bool -> Bool -> Bool -> Int -> Flags
Flags
    (Flags
a Flags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Flags Bool
Lens' Flags Bool
flgIndirect Bool -> Bool -> Bool
|| Flags
b Flags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Flags Bool
Lens' Flags Bool
flgIndirect)
    -- Definite action followed by a conditional action is a definite action.
    -- Conditional action followed by a definite action is a conditional action.
    (Flags
a Flags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Flags Bool
Lens' Flags Bool
flgConditional)
    -- Two loops in sequence mean overall these two loops are no longer part of an outer loop.
    Bool
False
    -- If any of the actions have side-effects, the combination does, too.
    (Flags
a Flags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Flags Bool
Lens' Flags Bool
flgNonConst Bool -> Bool -> Bool
|| Flags
b Flags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Flags Bool
Lens' Flags Bool
flgNonConst)
    -- Two operations in sequence stop being nested.
    (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Flags
a Flags -> Getting Int Flags Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Flags Int
Lens' Flags Int
flgNested) (Flags
b Flags -> Getting Int Flags Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Flags Int
Lens' Flags Int
flgNested)))

orFlags :: Flags -> Flags -> Flags
Flags
a orFlags :: Flags -> Flags -> Flags
`orFlags` Flags
b = Bool -> Bool -> Bool -> Bool -> Int -> Flags
Flags
    (Flags
a Flags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Flags Bool
Lens' Flags Bool
flgIndirect    Bool -> Bool -> Bool
|| Flags
b Flags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Flags Bool
Lens' Flags Bool
flgIndirect   )
    (Flags
a Flags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Flags Bool
Lens' Flags Bool
flgConditional Bool -> Bool -> Bool
|| Flags
b Flags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Flags Bool
Lens' Flags Bool
flgConditional)
    (Flags
a Flags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Flags Bool
Lens' Flags Bool
flgLoop        Bool -> Bool -> Bool
|| Flags
b Flags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Flags Bool
Lens' Flags Bool
flgLoop       )
    (Flags
a Flags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Flags Bool
Lens' Flags Bool
flgNonConst    Bool -> Bool -> Bool
|| Flags
b Flags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Flags Bool
Lens' Flags Bool
flgNonConst   )
    -- Nested operations remain nested in conditionals if both were nested
    -- If one operation was not nested, e.g. one was part of the if-condition, the result is not
    -- nested anymore.
    (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Flags
a Flags -> Getting Int Flags Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Flags Int
Lens' Flags Int
flgNested) (Flags
b Flags -> Getting Int Flags Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Flags Int
Lens' Flags Int
flgNested))

defaultFlags :: Flags
defaultFlags :: Flags
defaultFlags = Bool -> Bool -> Bool -> Bool -> Int -> Flags
Flags Bool
False Bool
False Bool
False Bool
False Int
0

data Operation = Operation
    { Operation -> Action
_opAct   :: Action
    , Operation -> Flags
_opFlags :: Flags
    }
    deriving (Int -> Operation -> ShowS
[Operation] -> ShowS
Operation -> String
(Int -> Operation -> ShowS)
-> (Operation -> String)
-> ([Operation] -> ShowS)
-> Show Operation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Operation] -> ShowS
$cshowList :: [Operation] -> ShowS
show :: Operation -> String
$cshow :: Operation -> String
showsPrec :: Int -> Operation -> ShowS
$cshowsPrec :: Int -> Operation -> ShowS
Show, Operation -> Operation -> Bool
(Operation -> Operation -> Bool)
-> (Operation -> Operation -> Bool) -> Eq Operation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operation -> Operation -> Bool
$c/= :: Operation -> Operation -> Bool
== :: Operation -> Operation -> Bool
$c== :: Operation -> Operation -> Bool
Eq)

makeLensesFor [("_opFlags", "opFlags")] ''Operation

op :: Action -> Operation
op :: Action -> Operation
op = (Action -> Flags -> Operation) -> Flags -> Action -> Operation
forall a b c. (a -> b -> c) -> b -> a -> c
flip Action -> Flags -> Operation
Operation Flags
defaultFlags

data Var = Var
    { Var -> Operation
_varOp   :: Operation
    , Var -> Maybe (Lexeme Text)
_varDecl :: Maybe (Lexeme Text)
    , Var -> Maybe (Lexeme Text)
_varUse  :: Maybe (Lexeme Text)
    }
    deriving (Int -> Var -> ShowS
[Var] -> ShowS
Var -> String
(Int -> Var -> ShowS)
-> (Var -> String) -> ([Var] -> ShowS) -> Show Var
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Var] -> ShowS
$cshowList :: [Var] -> ShowS
show :: Var -> String
$cshow :: Var -> String
showsPrec :: Int -> Var -> ShowS
$cshowsPrec :: Int -> Var -> ShowS
Show, Var -> Var -> Bool
(Var -> Var -> Bool) -> (Var -> Var -> Bool) -> Eq Var
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Var -> Var -> Bool
$c/= :: Var -> Var -> Bool
== :: Var -> Var -> Bool
$c== :: Var -> Var -> Bool
Eq)

makeLensesFor [("_varOp", "varOp")] ''Var

-- | Turn direct reads on the lhs of an assignment into writes.
--
-- `++` and `--` are considered assignments.
readTo :: Action -> Var -> Var
readTo :: Action -> Var -> Var
readTo Action
act (Var (Operation Action
Read flg :: Flags
flg@Flags{_flgIndirect :: Flags -> Bool
_flgIndirect = Bool
False}) Maybe (Lexeme Text)
decl Maybe (Lexeme Text)
use) =
    Operation -> Maybe (Lexeme Text) -> Maybe (Lexeme Text) -> Var
Var (Action -> Flags -> Operation
Operation Action
act Flags
flg) Maybe (Lexeme Text)
decl Maybe (Lexeme Text)
use
readTo Action
_ Var
var = Var
var

markConditional :: Map k Var -> Map k Var
markConditional :: Map k Var -> Map k Var
markConditional = (Var -> Var) -> Map k Var -> Map k Var
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((Var -> Var) -> Map k Var -> Map k Var)
-> (Var -> Var) -> Map k Var -> Map k Var
forall a b. (a -> b) -> a -> b
$ ASetter Var Var Bool Bool -> Bool -> Var -> Var
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Operation -> Identity Operation) -> Var -> Identity Var
Lens' Var Operation
varOp((Operation -> Identity Operation) -> Var -> Identity Var)
-> ((Bool -> Identity Bool) -> Operation -> Identity Operation)
-> ASetter Var Var Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Flags -> Identity Flags) -> Operation -> Identity Operation
Lens' Operation Flags
opFlags((Flags -> Identity Flags) -> Operation -> Identity Operation)
-> ((Bool -> Identity Bool) -> Flags -> Identity Flags)
-> (Bool -> Identity Bool)
-> Operation
-> Identity Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Flags -> Identity Flags
Lens' Flags Bool
flgConditional) Bool
True

-- | Combine 2 elements of a sequence of operations.
--
-- 'combineAnd a b' is called when first 'a' and then 'b' happens.
-- Example: `a = 3; print(a);` is a 'Write' and then a 'Read'.
combineAnd :: Var -> Var -> Var
-- Nested 'NoReduce' is thrown away when there's another variable with the same name at a higher up
-- scope.
combineAnd :: Var -> Var -> Var
combineAnd (Var (Operation Action
NoReduce Flags
flg) Maybe (Lexeme Text)
_ Maybe (Lexeme Text)
_) Var
v2 | Flags
flgFlags -> Getting Int Flags Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Flags Int
Lens' Flags Int
flgNested Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Var
v2
combineAnd Var
v1 (Var (Operation Action
NoReduce Flags
flg) Maybe (Lexeme Text)
_ Maybe (Lexeme Text)
_) | Flags
flgFlags -> Getting Int Flags Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Flags Int
Lens' Flags Int
flgNested Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Var
v1
-- All other situations are handled by the combineOp function below.
combineAnd (Var Operation
op1 Maybe (Lexeme Text)
decl1 Maybe (Lexeme Text)
use1) (Var Operation
op2 Maybe (Lexeme Text)
decl2 Maybe (Lexeme Text)
use2) =
--  trace (groom (Var op1 decl1 use1, "AND", Var op2 decl2 use2, "EQUALS", result) <> "\n") $
    Var
result
  where
    result :: Var
result = Operation -> Maybe (Lexeme Text) -> Maybe (Lexeme Text) -> Var
Var (Operation -> Operation -> Operation
combineOp Operation
op1 Operation
op2) (Maybe (Lexeme Text)
decl1 Maybe (Lexeme Text) -> Maybe (Lexeme Text) -> Maybe (Lexeme Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Lexeme Text)
decl2) (Maybe (Lexeme Text)
use1 Maybe (Lexeme Text) -> Maybe (Lexeme Text) -> Maybe (Lexeme Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Lexeme Text)
use2)

    combineOp :: Operation -> Operation -> Operation
combineOp (Operation Action
Declare Flags
a) (Operation Action
ReadWrite Flags
b)
        -- Read and write happening in a loop => possibly can't reduce.
      | Flags
bFlags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Flags Bool
Lens' Flags Bool
flgLoop = Action -> Flags -> Operation
Operation Action
NoReduce Flags
a

    combineOp (Operation Action
Declare Flags
a) (Operation Action
_ Flags
b)
        -- Declaration has side-effects in its initialiser => keep it where it was.
      | Flags
aFlags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Flags Bool
Lens' Flags Bool
flgNonConst = Action -> Flags -> Operation
Operation Action
NoReduce Flags
a
        -- Declaration is in the same scope as an operation => ignore the declare, marking this
        -- particular declaration as not reducible. We may still find reducible ones later in case
        -- of shadowing or `#if`/`#else`.
      | Flags
bFlags -> Getting Int Flags Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Flags Int
Lens' Flags Int
flgNested Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Action -> Flags -> Operation
Operation Action
NoReduce Flags
a
        -- Loops are nested twice: once for a potential for-init-decl and once for the body. The
        -- for-init-decl itself is not in the loop, but the other 2 components of the `for (...)`
        -- are. Anything declared in the current scope and referenced there will be at nesting level
        -- 1 and cannot be reduced in scope.
      | Flags
bFlags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Flags Bool
Lens' Flags Bool
flgLoop Bool -> Bool -> Bool
&& Flags
bFlags -> Getting Int Flags Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Flags Int
Lens' Flags Int
flgNested Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = Action -> Flags -> Operation
Operation Action
NoReduce Flags
a
        -- The first thing happening to this variable is something conditional. We err on the side
        -- of safety and ignore this situation.
      | Flags
bFlags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Flags Bool
Lens' Flags Bool
flgLoop Bool -> Bool -> Bool
&& Flags
bFlags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Flags Bool
Lens' Flags Bool
flgConditional = Action -> Flags -> Operation
Operation Action
NoReduce Flags
a
        -- Declaration has a trivial initialiser (no possible side-effects) and the read is nested,
        -- so we can reduce the scope of this variable.
      | Bool -> Bool
not (Flags
aFlags -> Getting Bool Flags Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Flags Bool
Lens' Flags Bool
flgNonConst) Bool -> Bool -> Bool
&& Flags
bFlags -> Getting Int Flags Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Flags Int
Lens' Flags Int
flgNested Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Action -> Flags -> Operation
Operation Action
Reduce Flags
a

    -- We found a declaration that can be reduced in scope and then an operation (maybe another
    -- declaration) on a variable with the same name but in a different scope. We ignore the second
    -- one and just keep the first declaration for diagnostics.
    combineOp (Operation Action
Reduce Flags
a) Operation
_ | Flags
aFlags -> Getting Int Flags Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Flags Int
Lens' Flags Int
flgNested Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Operation
op1

    -- We already know the scope can't be reduced, so any combination in the same scope won't make a
    -- difference.
    combineOp (Operation Action
NoReduce Flags
a) Operation
_ | Flags
aFlags -> Getting Int Flags Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Flags Int
Lens' Flags Int
flgNested Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Operation
op1

    combineOp (Operation Action
act1 Flags
flg1) (Operation Action
act2 Flags
flg2) =
        Action -> Flags -> Operation
Operation (Action -> Action -> Action
combineAction Action
act1 Action
act2) (Flags
flg1 Flags -> Flags -> Flags
`andFlags` Flags
flg2)

    combineAction :: Action -> Action -> Action
combineAction Action
Reduce    Action
Reduce    = Action
Reduce
    combineAction Action
Reduce    Action
NoReduce  = Action
Reduce
    combineAction Action
NoReduce  Action
NoReduce  = Action
NoReduce

    -- We can reduce the scope of first one, and then we can copy the declaration for the second
    -- one. Example: `int i; for (i = 0; ...){} for (i = 0; ...){}`.
    combineAction Action
Reduce    Action
Write     = Action
Reduce
    combineAction Action
Reduce    Action
ReadWrite = Action
Reduce

    -- We thought we can reduce the scope, but then the result is actually read in the current
    -- scope, so we flip the decision to 'NoReduce'.
    combineAction Action
Reduce    Action
Read      = Action
NoReduce

    -- Write, then read => keep the (possibly conditional) write.
    combineAction Action
Write     Action
Read      = Action
Write
    combineAction Action
Write     Action
Write     = Action
Write
    combineAction Action
Write     Action
ReadWrite = Action
Write

    -- Two reads combine into a read.
    combineAction Action
Read      Action
Read      = Action
Read

    -- Read or read/write then write: record as read/write.
    combineAction Action
Read      Action
Write     = Action
ReadWrite
    combineAction Action
ReadWrite Action
Write     = Action
ReadWrite
    combineAction Action
ReadWrite Action
Read      = Action
ReadWrite
    combineAction Action
Read      Action
ReadWrite = Action
ReadWrite
    combineAction Action
ReadWrite Action
ReadWrite = Action
ReadWrite
    combineAction Action
_ Action
_                 = String -> Action
forall a. HasCallStack => String -> a
error ((Operation, Operation) -> String
forall a. Show a => a -> String
groom (Operation
op1, Operation
op2))

-- | Combine 2 elements of a choice of operations.
--
-- 'combineOr a b' is called when either 'a' or 'b' happens, but never both.
-- Example: `if (c) { a = 3; } else { print(a); }` is either a 'Write' or a 'Read'.
combineOr :: Var -> Var -> Var
combineOr :: Var -> Var -> Var
combineOr v1 :: Var
v1@(Var (Operation Action
Reduce Flags
_) Maybe (Lexeme Text)
_ Maybe (Lexeme Text)
_) (Var (Operation Action
Reduce Flags
_) Maybe (Lexeme Text)
_ Maybe (Lexeme Text)
_) = Var
v1
combineOr v1 :: Var
v1@(Var (Operation Action
NoReduce Flags
_) Maybe (Lexeme Text)
_ Maybe (Lexeme Text)
_) (Var (Operation Action
NoReduce Flags
_) Maybe (Lexeme Text)
_ Maybe (Lexeme Text)
_) = Var
v1
combineOr v1 :: Var
v1@(Var (Operation Action
Declare Flags
_) Maybe (Lexeme Text)
_ Maybe (Lexeme Text)
_) (Var (Operation Action
Declare Flags
_) Maybe (Lexeme Text)
_ Maybe (Lexeme Text)
_) = Var
v1

combineOr (Var (Operation Action
act1 Flags
flg1) Maybe (Lexeme Text)
decl1 Maybe (Lexeme Text)
use1) (Var (Operation Action
act2 Flags
flg2) Maybe (Lexeme Text)
decl2 Maybe (Lexeme Text)
use2) =
--  trace (groom ((Var (Operation act1 flg1) decl1 use1), "OR", (Var (Operation act2 flg2) decl2 use2), "EQUALS", result) <> "\n") $
    Var
result
  where
    result :: Var
result = Operation -> Maybe (Lexeme Text) -> Maybe (Lexeme Text) -> Var
Var Operation
combinedOp (Maybe (Lexeme Text) -> Maybe (Lexeme Text) -> Maybe (Lexeme Text)
forall a. Maybe a -> Maybe a -> Maybe a
select Maybe (Lexeme Text)
decl1 Maybe (Lexeme Text)
decl2) (Maybe (Lexeme Text) -> Maybe (Lexeme Text) -> Maybe (Lexeme Text)
forall a. Maybe a -> Maybe a -> Maybe a
select Maybe (Lexeme Text)
use1 Maybe (Lexeme Text)
use2)

    combinedOp :: Operation
combinedOp
        -- Definite read, write, or read+write: both branches do the same => remove conditional flag.
      | Action
act1 Action -> Action -> Bool
forall a. Eq a => a -> a -> Bool
== Action
act2 = Action -> Flags -> Operation
Operation Action
act1 (Flags
flg1 Flags -> Flags -> Flags
`orFlags` Flags
flg2){_flgConditional :: Bool
_flgConditional = Bool
False}
        -- Either written or read => consider it as conditional write.
      | Bool
otherwise = Action -> Flags -> Operation
Operation (Action -> Action -> Action
forall a. Ord a => a -> a -> a
max Action
act1 Action
act2) (Flags
flg1 Flags -> Flags -> Flags
`orFlags` Flags
flg2)

    select :: Maybe a -> Maybe a -> Maybe a
select a :: Maybe a
a@Just{} b :: Maybe a
b@Just{} = if Action
act1 Action -> Action -> Bool
forall a. Ord a => a -> a -> Bool
> Action
act2 then Maybe a
a else Maybe a
b
    select Maybe a
a Maybe a
b               = Maybe a
a Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a
b

-- | Mark the callee as introducing side-effects into the expression.
processFunctionCall :: Map Text Var -> [Map Text Var] -> Map Text Var
processFunctionCall :: Map Text Var -> [Map Text Var] -> Map Text Var
processFunctionCall Map Text Var
callee [Map Text Var]
args =
    (Var -> Var -> Var) -> [Map Text Var] -> Map Text Var
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Var -> Var -> Var
combineAnd ([Map Text Var] -> Map Text Var) -> [Map Text Var] -> Map Text Var
forall a b. (a -> b) -> a -> b
$ (Var -> Var) -> Map Text Var -> Map Text Var
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (ASetter Var Var Bool Bool -> Bool -> Var -> Var
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Operation -> Identity Operation) -> Var -> Identity Var
Lens' Var Operation
varOp((Operation -> Identity Operation) -> Var -> Identity Var)
-> ((Bool -> Identity Bool) -> Operation -> Identity Operation)
-> ASetter Var Var Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Flags -> Identity Flags) -> Operation -> Identity Operation
Lens' Operation Flags
opFlags((Flags -> Identity Flags) -> Operation -> Identity Operation)
-> ((Bool -> Identity Bool) -> Flags -> Identity Flags)
-> (Bool -> Identity Bool)
-> Operation
-> Identity Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Flags -> Identity Flags
Lens' Flags Bool
flgNonConst) Bool
True) Map Text Var
callee Map Text Var -> [Map Text Var] -> [Map Text Var]
forall a. a -> [a] -> [a]
: [Map Text Var]
args

varScopes :: NodeF (Lexeme Text) (Map Text Var) -> Map Text Var
varScopes :: NodeF (Lexeme Text) (Map Text Var) -> Map Text Var
varScopes = \case
    IfStmt Map Text Var
c Map Text Var
t Maybe (Map Text Var)
Nothing       -> (Var -> Var -> Var) -> Map Text Var -> Map Text Var -> Map Text Var
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Var -> Var -> Var
combineAnd Map Text Var
c (Map Text Var -> Map Text Var) -> Map Text Var -> Map Text Var
forall a b. (a -> b) -> a -> b
$ Map Text Var -> Map Text Var
forall k. Map k Var -> Map k Var
markConditional Map Text Var
t
    IfStmt Map Text Var
c Map Text Var
t (Just Map Text Var
e)      -> (Var -> Var -> Var) -> Map Text Var -> Map Text Var -> Map Text Var
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Var -> Var -> Var
combineAnd Map Text Var
c (Map Text Var -> Map Text Var) -> Map Text Var -> Map Text Var
forall a b. (a -> b) -> a -> b
$ (Var -> Var -> Var) -> Map Text Var -> Map Text Var -> Map Text Var
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Var -> Var -> Var
combineOr (Map Text Var -> Map Text Var
forall k. Map k Var -> Map k Var
markConditional Map Text Var
t) (Map Text Var -> Map Text Var
forall k. Map k Var -> Map k Var
markConditional Map Text Var
e)

    -- Only non-array variables are recorded. Arrays are tricky because of implicit pointer
    -- conversion and the way we use them. See the "ignores array-typed variables" test cases for
    -- examples that are non-trivial to statically analyse with the method we're using here.
    VarDecl Map Text Var
t Lexeme Text
var []         -> Text -> Var -> Map Text Var -> Map Text Var
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText Lexeme Text
var) (Operation -> Maybe (Lexeme Text) -> Maybe (Lexeme Text) -> Var
Var (Action -> Operation
op Action
Declare) (Lexeme Text -> Maybe (Lexeme Text)
forall a. a -> Maybe a
Just Lexeme Text
var) Maybe (Lexeme Text)
forall a. Maybe a
Nothing) Map Text Var
t
    VarDeclStmt Map Text Var
var Maybe (Map Text Var)
iexpr    -> Map Text Var
-> (Map Text Var -> Map Text Var)
-> Maybe (Map Text Var)
-> Map Text Var
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Text Var
var (\Map Text Var
e -> (Var -> Var -> Var) -> Map Text Var -> Map Text Var -> Map Text Var
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Var -> Var -> Var
combineAnd (Map Text Var -> Map Text Var -> Map Text Var
forall k a k. Map k a -> Map k Var -> Map k Var
propagateNonConst Map Text Var
e Map Text Var
var) Map Text Var
e) Maybe (Map Text Var)
iexpr

    VarExpr Lexeme Text
var              -> Text -> Var -> Map Text Var
forall k a. k -> a -> Map k a
Map.singleton (Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText Lexeme Text
var) (Operation -> Maybe (Lexeme Text) -> Maybe (Lexeme Text) -> Var
Var (Action -> Operation
op Action
Read) Maybe (Lexeme Text)
forall a. Maybe a
Nothing (Lexeme Text -> Maybe (Lexeme Text)
forall a. a -> Maybe a
Just Lexeme Text
var))
    AssignExpr Map Text Var
lhs AssignOp
AopEq Map Text Var
rhs -> (Var -> Var -> Var) -> Map Text Var -> Map Text Var -> Map Text Var
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Var -> Var -> Var
combineAnd ((Var -> Var) -> Map Text Var -> Map Text Var
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Action -> Var -> Var
readTo Action
Write) Map Text Var
lhs) Map Text Var
rhs
    AssignExpr Map Text Var
lhs AssignOp
_ Map Text Var
rhs     -> (Var -> Var -> Var) -> Map Text Var -> Map Text Var -> Map Text Var
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Var -> Var -> Var
combineAnd ((Var -> Var) -> Map Text Var -> Map Text Var
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Action -> Var -> Var
readTo Action
ReadWrite) Map Text Var
lhs) Map Text Var
rhs

    -- ++ and -- do both read and write.
    UnaryExpr UnaryOp
UopIncr Map Text Var
e      -> (Var -> Var) -> Map Text Var -> Map Text Var
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Action -> Var -> Var
readTo Action
ReadWrite) Map Text Var
e
    UnaryExpr UnaryOp
UopDecr Map Text Var
e      -> (Var -> Var) -> Map Text Var -> Map Text Var
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Action -> Var -> Var
readTo Action
ReadWrite) Map Text Var
e

    -- &var is considered a write, but since it can occur inside an expression (e.g. function call),
    -- it's considered negatively nested. When nesting once (e.g. inside a for-init-decl), it's not
    -- considered nested. When nesting twice (e.g. inside the for-body), it is considered nested
    -- once.
    UnaryExpr UnaryOp
UopAddress Map Text Var
e   -> Int -> Map Text Var -> Map Text Var
forall k. Int -> Map k Var -> Map k Var
nested (-Int
1) (Map Text Var -> Map Text Var) -> Map Text Var -> Map Text Var
forall a b. (a -> b) -> a -> b
$ (Var -> Var) -> Map Text Var -> Map Text Var
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Action -> Var -> Var
readTo Action
Write) Map Text Var
e
    UnaryExpr UnaryOp
UopDeref Map Text Var
e     -> Map Text Var -> Map Text Var
forall k. Map k Var -> Map k Var
indirect Map Text Var
e
    MemberAccess Map Text Var
e Lexeme Text
_         -> Map Text Var -> Map Text Var
forall k. Map k Var -> Map k Var
indirect Map Text Var
e
    PointerAccess Map Text Var
e Lexeme Text
_        -> Map Text Var -> Map Text Var
forall k. Map k Var -> Map k Var
indirect Map Text Var
e
    ArrayAccess Map Text Var
e Map Text Var
i          -> Map Text Var -> Map Text Var
forall k. Map k Var -> Map k Var
indirect (Map Text Var -> Map Text Var) -> Map Text Var -> Map Text Var
forall a b. (a -> b) -> a -> b
$ (Var -> Var -> Var) -> Map Text Var -> Map Text Var -> Map Text Var
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Var -> Var -> Var
combineAnd Map Text Var
e Map Text Var
i

    -- Ignore parameter declarations. These can never be reduced in scope.
    FunctionPrototype{}      -> Map Text Var
forall k a. Map k a
Map.empty

    FunctionCall Map Text Var
callee [Map Text Var]
args -> Map Text Var -> [Map Text Var] -> Map Text Var
processFunctionCall Map Text Var
callee [Map Text Var]
args

    ForStmt Map Text Var
i Map Text Var
c Map Text Var
n Map Text Var
b          -> Int -> Map Text Var -> Map Text Var
forall k. Int -> Map k Var -> Map k Var
nested Int
1 (Map Text Var -> Map Text Var)
-> ([Map Text Var] -> Map Text Var)
-> [Map Text Var]
-> Map Text Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var -> Var -> Var) -> Map Text Var -> Map Text Var -> Map Text Var
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Var -> Var -> Var
combineAnd Map Text Var
i (Map Text Var -> Map Text Var)
-> ([Map Text Var] -> Map Text Var)
-> [Map Text Var]
-> Map Text Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Var -> Map Text Var
forall k. Map k Var -> Map k Var
inLoop (Map Text Var -> Map Text Var)
-> ([Map Text Var] -> Map Text Var)
-> [Map Text Var]
-> Map Text Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var -> Var -> Var) -> [Map Text Var] -> Map Text Var
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Var -> Var -> Var
combineAnd ([Map Text Var] -> Map Text Var) -> [Map Text Var] -> Map Text Var
forall a b. (a -> b) -> a -> b
$ [Map Text Var
c, Map Text Var
n, Map Text Var
b]
    node :: NodeF (Lexeme Text) (Map Text Var)
node@WhileStmt{}         -> Int -> Map Text Var -> Map Text Var
forall k. Int -> Map k Var -> Map k Var
nested Int
1 (Map Text Var -> Map Text Var)
-> (NodeF (Lexeme Text) (Map Text Var) -> Map Text Var)
-> NodeF (Lexeme Text) (Map Text Var)
-> Map Text Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Var -> Map Text Var
forall k. Map k Var -> Map k Var
inLoop (Map Text Var -> Map Text Var)
-> (NodeF (Lexeme Text) (Map Text Var) -> Map Text Var)
-> NodeF (Lexeme Text) (Map Text Var)
-> Map Text Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var -> Var -> Var)
-> NodeF (Lexeme Text) (Map Text Var) -> Map Text Var
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Var -> Var -> Var
combineAnd (NodeF (Lexeme Text) (Map Text Var) -> Map Text Var)
-> NodeF (Lexeme Text) (Map Text Var) -> Map Text Var
forall a b. (a -> b) -> a -> b
$ NodeF (Lexeme Text) (Map Text Var)
node
    node :: NodeF (Lexeme Text) (Map Text Var)
node@DoWhileStmt{}       -> Int -> Map Text Var -> Map Text Var
forall k. Int -> Map k Var -> Map k Var
nested Int
1 (Map Text Var -> Map Text Var)
-> (NodeF (Lexeme Text) (Map Text Var) -> Map Text Var)
-> NodeF (Lexeme Text) (Map Text Var)
-> Map Text Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Var -> Map Text Var
forall k. Map k Var -> Map k Var
inLoop (Map Text Var -> Map Text Var)
-> (NodeF (Lexeme Text) (Map Text Var) -> Map Text Var)
-> NodeF (Lexeme Text) (Map Text Var)
-> Map Text Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var -> Var -> Var)
-> NodeF (Lexeme Text) (Map Text Var) -> Map Text Var
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Var -> Var -> Var
combineAnd (NodeF (Lexeme Text) (Map Text Var) -> Map Text Var)
-> NodeF (Lexeme Text) (Map Text Var) -> Map Text Var
forall a b. (a -> b) -> a -> b
$ NodeF (Lexeme Text) (Map Text Var)
node
    node :: NodeF (Lexeme Text) (Map Text Var)
node@CompoundStmt{}      -> Int -> Map Text Var -> Map Text Var
forall k. Int -> Map k Var -> Map k Var
nested Int
1 (Map Text Var -> Map Text Var)
-> (NodeF (Lexeme Text) (Map Text Var) -> Map Text Var)
-> NodeF (Lexeme Text) (Map Text Var)
-> Map Text Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var -> Var -> Var)
-> NodeF (Lexeme Text) (Map Text Var) -> Map Text Var
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Var -> Var -> Var
combineAnd (NodeF (Lexeme Text) (Map Text Var) -> Map Text Var)
-> NodeF (Lexeme Text) (Map Text Var) -> Map Text Var
forall a b. (a -> b) -> a -> b
$ NodeF (Lexeme Text) (Map Text Var)
node

    NodeF (Lexeme Text) (Map Text Var)
node                     -> (Var -> Var -> Var)
-> NodeF (Lexeme Text) (Map Text Var) -> Map Text Var
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Var -> Var -> Var
combineAnd NodeF (Lexeme Text) (Map Text Var)
node
  where
    propagateNonConst :: Map k a -> Map k Var -> Map k Var
propagateNonConst Map k a
e = if Map k a -> Bool
forall k a. Map k a -> Bool
Map.null Map k a
e then Map k Var -> Map k Var
forall a. a -> a
id else (Var -> Var) -> Map k Var -> Map k Var
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (ASetter Var Var Bool Bool -> Bool -> Var -> Var
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Operation -> Identity Operation) -> Var -> Identity Var
Lens' Var Operation
varOp((Operation -> Identity Operation) -> Var -> Identity Var)
-> ((Bool -> Identity Bool) -> Operation -> Identity Operation)
-> ASetter Var Var Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Flags -> Identity Flags) -> Operation -> Identity Operation
Lens' Operation Flags
opFlags((Flags -> Identity Flags) -> Operation -> Identity Operation)
-> ((Bool -> Identity Bool) -> Flags -> Identity Flags)
-> (Bool -> Identity Bool)
-> Operation
-> Identity Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Flags -> Identity Flags
Lens' Flags Bool
flgNonConst) Bool
True)
    indirect :: Map k Var -> Map k Var
indirect = (Var -> Var) -> Map k Var -> Map k Var
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (ASetter Var Var Bool Bool -> Bool -> Var -> Var
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Operation -> Identity Operation) -> Var -> Identity Var
Lens' Var Operation
varOp((Operation -> Identity Operation) -> Var -> Identity Var)
-> ((Bool -> Identity Bool) -> Operation -> Identity Operation)
-> ASetter Var Var Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Flags -> Identity Flags) -> Operation -> Identity Operation
Lens' Operation Flags
opFlags((Flags -> Identity Flags) -> Operation -> Identity Operation)
-> ((Bool -> Identity Bool) -> Flags -> Identity Flags)
-> (Bool -> Identity Bool)
-> Operation
-> Identity Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Flags -> Identity Flags
Lens' Flags Bool
flgIndirect) Bool
True)
    nested :: Int -> Map k Var -> Map k Var
nested Int
n = (Var -> Var) -> Map k Var -> Map k Var
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (ASetter Var Var Int Int -> (Int -> Int) -> Var -> Var
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Operation -> Identity Operation) -> Var -> Identity Var
Lens' Var Operation
varOp((Operation -> Identity Operation) -> Var -> Identity Var)
-> ((Int -> Identity Int) -> Operation -> Identity Operation)
-> ASetter Var Var Int Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Flags -> Identity Flags) -> Operation -> Identity Operation
Lens' Operation Flags
opFlags((Flags -> Identity Flags) -> Operation -> Identity Operation)
-> ((Int -> Identity Int) -> Flags -> Identity Flags)
-> (Int -> Identity Int)
-> Operation
-> Identity Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> Flags -> Identity Flags
Lens' Flags Int
flgNested) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n))
    inLoop :: Map k Var -> Map k Var
inLoop = (Var -> Var) -> Map k Var -> Map k Var
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (ASetter Var Var Bool Bool -> Bool -> Var -> Var
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Operation -> Identity Operation) -> Var -> Identity Var
Lens' Var Operation
varOp((Operation -> Identity Operation) -> Var -> Identity Var)
-> ((Bool -> Identity Bool) -> Operation -> Identity Operation)
-> ASetter Var Var Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Flags -> Identity Flags) -> Operation -> Identity Operation
Lens' Operation Flags
opFlags((Flags -> Identity Flags) -> Operation -> Identity Operation)
-> ((Bool -> Identity Bool) -> Flags -> Identity Flags)
-> (Bool -> Identity Bool)
-> Operation
-> Identity Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Flags -> Identity Flags
Lens' Flags Bool
flgLoop) Bool
True)


linter :: AstActions (State [Text]) Text
linter :: AstActions (State [Text]) Text
linter = AstActions (State [Text]) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode :: String -> Node (Lexeme Text) -> State [Text] () -> State [Text] ()
doNode = \String
file Node (Lexeme Text)
node State [Text] ()
act ->
        case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
            FunctionDefn{} ->
                (Var -> State [Text] ()) -> [Var] -> State [Text] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Var -> State [Text] ()
forall diags.
HasDiagnostics diags =>
String -> Var -> StateT diags Identity ()
warnAbout String
file) ([Var] -> State [Text] ())
-> (Node (Lexeme Text) -> [Var])
-> Node (Lexeme Text)
-> State [Text] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Var -> [Var]
forall k a. Map k a -> [a]
Map.elems (Map Text Var -> [Var])
-> (Node (Lexeme Text) -> Map Text Var)
-> Node (Lexeme Text)
-> [Var]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeF (Lexeme Text) (Map Text Var) -> Map Text Var)
-> Node (Lexeme Text) -> Map Text Var
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix NodeF (Lexeme Text) (Map Text Var) -> Map Text Var
varScopes (Node (Lexeme Text) -> State [Text] ())
-> Node (Lexeme Text) -> State [Text] ()
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text)
node

            NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> State [Text] ()
act
    }
  where
      warnAbout :: String -> Var -> StateT diags Identity ()
warnAbout String
file Var
_ | String
"cmp.c" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
file = () -> StateT diags Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      warnAbout String
file (Var (Operation Action
Reduce Flags
_) (Just Lexeme Text
decl) (Just Lexeme Text
use)) = do
          String -> Lexeme Text -> Text -> StateT diags Identity ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
String -> at -> Text -> DiagnosticsT diags ()
warn String
file Lexeme Text
decl (Text -> StateT diags Identity ())
-> Text -> StateT diags Identity ()
forall a b. (a -> b) -> a -> b
$ Text
"variable `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText Lexeme Text
decl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` can be reduced in scope"
          String -> Lexeme Text -> Text -> StateT diags Identity ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
String -> at -> Text -> DiagnosticsT diags ()
warn String
file Lexeme Text
use    Text
"  possibly to here"
      warnAbout String
_ Var
_ = () -> StateT diags Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

analyse :: (FilePath, [Node (Lexeme Text)]) -> [Text]
analyse :: (String, [Node (Lexeme Text)]) -> [Text]
analyse = [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text])
-> ((String, [Node (Lexeme Text)]) -> [Text])
-> (String, [Node (Lexeme Text)])
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State [Text] () -> [Text] -> [Text])
-> [Text] -> State [Text] () -> [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State [Text] () -> [Text] -> [Text]
forall s a. State s a -> s -> s
State.execState [] (State [Text] () -> [Text])
-> ((String, [Node (Lexeme Text)]) -> State [Text] ())
-> (String, [Node (Lexeme Text)])
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (State [Text]) Text
-> (String, [Node (Lexeme Text)]) -> State [Text] ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State [Text]) Text
linter ((String, [Node (Lexeme Text)]) -> State [Text] ())
-> ((String, [Node (Lexeme Text)])
    -> (String, [Node (Lexeme Text)]))
-> (String, [Node (Lexeme Text)])
-> State [Text] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String]
-> (String, [Node (Lexeme Text)]) -> (String, [Node (Lexeme Text)])
Common.skip
    [ String
"third_party/cmp/cmp.c"
    ]

descr :: ((FilePath, [Node (Lexeme Text)]) -> [Text], (Text, Text))
descr :: ((String, [Node (Lexeme Text)]) -> [Text], (Text, Text))
descr = ((String, [Node (Lexeme Text)]) -> [Text]
analyse, (Text
"var-unused-in-scope", [Text] -> Text
Text.unlines
    [ Text
"Suggests reducing the scope of a local variable definition when possible."
    , Text
""
    , Text
"E.g.:"
    , Text
""
    , Text
"```cpp"
    , Text
"{"
    , Text
"  int a = get_a();"
    , Text
"  if (cond) {"
    , Text
"    do_something(a);"
    , Text
"    do_something_else(a);"
    , Text
"  }"
    , Text
"}"
    , Text
"```"
    , Text
""
    , Text
"could be written as:"
    , Text
""
    , Text
"```cpp"
    , Text
"{"
    , Text
"  if (cond) {"
    , Text
"    int a = get_a();"
    , Text
"    do_something(a);"
    , Text
"    do_something_else(a);"
    , Text
"  }"
    , Text
"}"
    , Text
"```"
    , Text
""
    , Text
"This can be semantically different if `get_a` has side-effects, so some care"
    , Text
"should be taken when applying suggested changes."
    , Text
""
    , Text
"**Reason:** having variables declared in their inner-most possible scope makes"
    , Text
"it clearer how much code can be influenced by that variable."
    ]))