{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}

module Jikka.RestrictedPython.Language.Lint where

import Control.Monad.Writer.Strict
import qualified Data.Set as S
import Jikka.Common.Error
import Jikka.RestrictedPython.Language.Builtin (builtinNames)
import Jikka.RestrictedPython.Language.Expr
import Jikka.RestrictedPython.Language.Util
import Jikka.RestrictedPython.Language.VariableAnalysis

makeEnsureProgram :: MonadError Error m => (Program -> Bool) -> String -> Program -> m ()
makeEnsureProgram :: (Program -> Bool) -> String -> Program -> m ()
makeEnsureProgram Program -> Bool
pred String
msg Program
prog =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Program -> Bool
pred Program
prog) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
msg

-- | `hasSubscriptionInLoopCounters` checks that there are `SubscriptTrg` in loop counters of for-loops.
-- This includes loop counters of `ListComp`.
-- For example, the followings has such subscriptions.
--
-- > for a[0] in range(100):
-- >     pass
-- > return a[0]  # => 99
--
-- > a = [0]
-- > b = [0 for a[0] in range(100)]
-- > return a[0]  # => 99
--
-- NOTE: This is allowd in the standard Python.
hasSubscriptionInLoopCounters :: Program -> Bool
hasSubscriptionInLoopCounters :: Program -> Bool
hasSubscriptionInLoopCounters Program
prog = (Statement -> Bool) -> [Statement] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Statement -> Bool
checkStatement (Program -> [Statement]
listStatements Program
prog) Bool -> Bool -> Bool
|| (WithLoc' Expr -> Bool) -> [WithLoc' Expr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any WithLoc' Expr -> Bool
checkExpr (Program -> [WithLoc' Expr]
listExprs Program
prog)
  where
    checkStatement :: Statement -> Bool
checkStatement = \case
      For Target'
x WithLoc' Expr
_ [Statement]
_ -> Target' -> Bool
hasSubscriptTrg Target'
x
      Statement
_ -> Bool
False
    checkExpr :: WithLoc' Expr -> Bool
checkExpr (WithLoc' Maybe Loc
_ Expr
x) = case Expr
x of
      ListComp WithLoc' Expr
_ (Comprehension Target'
x WithLoc' Expr
_ Maybe (WithLoc' Expr)
_) -> Target' -> Bool
hasSubscriptTrg Target'
x
      Expr
_ -> Bool
False

doesntHaveSubscriptionInLoopCounters :: Program -> Bool
doesntHaveSubscriptionInLoopCounters :: Program -> Bool
doesntHaveSubscriptionInLoopCounters = Bool -> Bool
not (Bool -> Bool) -> (Program -> Bool) -> Program -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> Bool
hasSubscriptionInLoopCounters

ensureDoesntHaveSubscriptionInLoopCounters :: MonadError Error m => Program -> m ()
ensureDoesntHaveSubscriptionInLoopCounters :: Program -> m ()
ensureDoesntHaveSubscriptionInLoopCounters = (Program -> Bool) -> String -> Program -> m ()
forall (m :: * -> *).
MonadError Error m =>
(Program -> Bool) -> String -> Program -> m ()
makeEnsureProgram Program -> Bool
doesntHaveSubscriptionInLoopCounters String
"there must not be subscription in loop counters"

-- | `hasLeakOfLoopCounters` checks that there are leaks of loop counters of for-loops.
-- For example, the following has a leak.
--
-- > for i in range(100):
-- >     pass
-- > return i  # => 100
hasLeakOfLoopCounters :: Program -> Bool
hasLeakOfLoopCounters :: Program -> Bool
hasLeakOfLoopCounters Program
_ = Bool
False -- TODO

doesntHaveLeakOfLoopCounters :: Program -> Bool
doesntHaveLeakOfLoopCounters :: Program -> Bool
doesntHaveLeakOfLoopCounters = Bool -> Bool
not (Bool -> Bool) -> (Program -> Bool) -> Program -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> Bool
hasLeakOfLoopCounters

ensureDoesntHaveLeakOfLoopCounters :: MonadError Error m => Program -> m ()
ensureDoesntHaveLeakOfLoopCounters :: Program -> m ()
ensureDoesntHaveLeakOfLoopCounters = (Program -> Bool) -> String -> Program -> m ()
forall (m :: * -> *).
MonadError Error m =>
(Program -> Bool) -> String -> Program -> m ()
makeEnsureProgram Program -> Bool
doesntHaveLeakOfLoopCounters String
"there must not be leaks of loop counters"

-- | `hasAssignmentToLoopCounters` checks that there are assignments to loop counters of for-loops.
-- For example, the following has the assignment.
--
-- > for i in range(100):
-- >     i += 1
hasAssignmentToLoopCounters :: Program -> Bool
hasAssignmentToLoopCounters :: Program -> Bool
hasAssignmentToLoopCounters Program
prog = (Statement -> Bool) -> [Statement] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Statement -> Bool
check (Program -> [Statement]
listStatements Program
prog)
  where
    check :: Statement -> Bool
check = \case
      For Target'
x WithLoc' Expr
_ [Statement]
body ->
        let r :: ReadList
r = [VarName] -> ReadList
ReadList ([VarName] -> ReadList) -> [VarName] -> ReadList
forall a b. (a -> b) -> a -> b
$ Target' -> [VarName]
targetVars Target'
x
            (ReadList
_, WriteList
w) = [Statement] -> (ReadList, WriteList)
analyzeStatementsMax [Statement]
body
         in WriteList -> ReadList -> Bool
haveWriteReadIntersection WriteList
w ReadList
r
      Statement
_ -> Bool
False

doesntHaveAssignmentToLoopCounters :: Program -> Bool
doesntHaveAssignmentToLoopCounters :: Program -> Bool
doesntHaveAssignmentToLoopCounters = Bool -> Bool
not (Bool -> Bool) -> (Program -> Bool) -> Program -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> Bool
hasAssignmentToLoopCounters

ensureDoesntHaveAssignmentToLoopCounters :: MonadError Error m => Program -> m ()
ensureDoesntHaveAssignmentToLoopCounters :: Program -> m ()
ensureDoesntHaveAssignmentToLoopCounters = (Program -> Bool) -> String -> Program -> m ()
forall (m :: * -> *).
MonadError Error m =>
(Program -> Bool) -> String -> Program -> m ()
makeEnsureProgram Program -> Bool
doesntHaveAssignmentToLoopCounters String
"there must not be assignments to loop counters"

-- | `hasAssignmentToLoopIterators` checks that there are assignments to loop iterators of for-loops.
-- For example, the followings have the assignments.
--
-- > a = list(range(10))
-- > for i in a:
-- >     a[5] = i
--
-- > a = 0
-- > for i in f(a):
-- >     a += i
hasAssignmentToLoopIterators :: Program -> Bool
hasAssignmentToLoopIterators :: Program -> Bool
hasAssignmentToLoopIterators Program
prog = (Statement -> Bool) -> [Statement] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Statement -> Bool
check (Program -> [Statement]
listStatements Program
prog)
  where
    check :: Statement -> Bool
check = \case
      For Target'
_ WithLoc' Expr
iter [Statement]
body ->
        let r :: ReadList
r = WithLoc' Expr -> ReadList
analyzeExpr WithLoc' Expr
iter
            (ReadList
_, WriteList
w) = [Statement] -> (ReadList, WriteList)
analyzeStatementsMax [Statement]
body
         in WriteList -> ReadList -> Bool
haveWriteReadIntersection WriteList
w ReadList
r
      Statement
_ -> Bool
False

doesntHaveAssignmentToLoopIterators :: Program -> Bool
doesntHaveAssignmentToLoopIterators :: Program -> Bool
doesntHaveAssignmentToLoopIterators = Bool -> Bool
not (Bool -> Bool) -> (Program -> Bool) -> Program -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> Bool
hasAssignmentToLoopIterators

ensureDoesntHaveAssignmentToLoopIterators :: MonadError Error m => Program -> m ()
ensureDoesntHaveAssignmentToLoopIterators :: Program -> m ()
ensureDoesntHaveAssignmentToLoopIterators = (Program -> Bool) -> String -> Program -> m ()
forall (m :: * -> *).
MonadError Error m =>
(Program -> Bool) -> String -> Program -> m ()
makeEnsureProgram Program -> Bool
doesntHaveAssignmentToLoopIterators String
"there must not be assignments changing loop iterators"

-- | `hasReturnInLoops` checks that there are return-statements in for-loops.
-- For example, the following has such a return-statement.
--
-- > a = list(range(10))
-- > for i in a:
-- >     return True
hasReturnInLoops :: Program -> Bool
hasReturnInLoops :: Program -> Bool
hasReturnInLoops = Any -> Bool
getAny (Any -> Bool) -> (Program -> Any) -> Program -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer Any Program -> Any
forall w a. Writer w a -> w
execWriter (Writer Any Program -> Any)
-> (Program -> Writer Any Program) -> Program -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithLoc' Expr
 -> [Statement] -> [Statement] -> WriterT Any Identity [Statement])
-> (Target'
    -> WithLoc' Expr
    -> [Statement]
    -> WriterT Any Identity [Statement])
-> Program
-> Writer Any Program
forall (m :: * -> *).
Monad m =>
(WithLoc' Expr -> [Statement] -> [Statement] -> m [Statement])
-> (Target' -> WithLoc' Expr -> [Statement] -> m [Statement])
-> Program
-> m Program
mapLargeStatementM WithLoc' Expr
-> [Statement] -> [Statement] -> WriterT Any Identity [Statement]
forall (m :: * -> *).
Monad m =>
WithLoc' Expr -> [Statement] -> [Statement] -> m [Statement]
fIf Target'
-> WithLoc' Expr -> [Statement] -> WriterT Any Identity [Statement]
forall (m :: * -> *).
MonadWriter Any m =>
Target' -> WithLoc' Expr -> [Statement] -> m [Statement]
fFor
  where
    fIf :: WithLoc' Expr -> [Statement] -> [Statement] -> m [Statement]
fIf WithLoc' Expr
e [Statement]
body1 [Statement]
body2 = [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [WithLoc' Expr -> [Statement] -> [Statement] -> Statement
If WithLoc' Expr
e [Statement]
body1 [Statement]
body2]
    fFor :: Target' -> WithLoc' Expr -> [Statement] -> m [Statement]
fFor Target'
x WithLoc' Expr
iter [Statement]
body = do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Statement -> Bool) -> [Statement] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Statement -> Bool
doesPossiblyReturn [Statement]
body) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Any -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Any -> m ()) -> Any -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
      [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Target' -> WithLoc' Expr -> [Statement] -> Statement
For Target'
x WithLoc' Expr
iter [Statement]
body]

doesntHaveReturnInLoops :: Program -> Bool
doesntHaveReturnInLoops :: Program -> Bool
doesntHaveReturnInLoops = Bool -> Bool
not (Bool -> Bool) -> (Program -> Bool) -> Program -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> Bool
hasReturnInLoops

ensureDoesntHaveReturnInLoops :: MonadError Error m => Program -> m ()
ensureDoesntHaveReturnInLoops :: Program -> m ()
ensureDoesntHaveReturnInLoops = (Program -> Bool) -> String -> Program -> m ()
forall (m :: * -> *).
MonadError Error m =>
(Program -> Bool) -> String -> Program -> m ()
makeEnsureProgram Program -> Bool
doesntHaveReturnInLoops String
"there must not be return-statements in for-loops"

-- | `hasMixedAssignment` checks that there are assignments which assign to both of bare variables and subscripted variables.
-- For example, the following is such an assignment.
--
-- > a, b[0] = list(range(10))
--
-- NOTE: this doesn't check loop counters of `For` or `ListComp`.
hasMixedAssignment :: Program -> Bool
hasMixedAssignment :: Program -> Bool
hasMixedAssignment Program
prog = (Statement -> Bool) -> [Statement] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Statement -> Bool
check (Program -> [Statement]
listStatements Program
prog)
  where
    check :: Statement -> Bool
check = \case
      AugAssign Target'
x Operator
_ WithLoc' Expr
_ -> Target' -> Bool
hasSubscriptTrg Target'
x Bool -> Bool -> Bool
&& Target' -> Bool
hasBareNameTrg Target'
x
      AnnAssign Target'
x Type
_ WithLoc' Expr
_ -> Target' -> Bool
hasSubscriptTrg Target'
x Bool -> Bool -> Bool
&& Target' -> Bool
hasBareNameTrg Target'
x
      Statement
_ -> Bool
False

doesntHaveMixedAssignment :: Program -> Bool
doesntHaveMixedAssignment :: Program -> Bool
doesntHaveMixedAssignment = Bool -> Bool
not (Bool -> Bool) -> (Program -> Bool) -> Program -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> Bool
hasMixedAssignment

ensureDoesntHaveMixedAssignment :: MonadError Error m => Program -> m ()
ensureDoesntHaveMixedAssignment :: Program -> m ()
ensureDoesntHaveMixedAssignment = (Program -> Bool) -> String -> Program -> m ()
forall (m :: * -> *).
MonadError Error m =>
(Program -> Bool) -> String -> Program -> m ()
makeEnsureProgram Program -> Bool
doesntHaveMixedAssignment String
"there must not be mixed assignments"

-- | `hasNonTrivialSubscriptedAssignmentInForLoops` checks that there are assignments with non-trivial subscriptions in for-loops.
-- A trivial subscription is a sequence of subscriptions to a variable with constant indices and at most one trivial loop-counter indices for each loops.
-- A constant index is an expr which has a constant value in the loop.
-- A trivial loop-counter index is the loop counter from "range(n)", "range(n, m)" or "enumerate(a)" with optional post-addition with a positive int literal.
--
-- For example, the followings have such assignments.
--
-- > x = 0
-- > for i in range(10):
-- >     x += 1
-- >     a[x] += 1
--
-- > for i in range(10):
-- >     j = i
-- >     a[j] += 1
--
-- > for i in range(10):
-- >     a[2 * i] += 1
--
-- > for i in range(10):
-- >     a[1 + i] += 1
--
-- > for i in range(10):
-- >     a[i - 1] += 1
--
-- > c = 1
-- > for i in range(10):
-- >     a[i + c] += 1
--
-- > for i in range(10):
-- >     a[i][i] += 1
--
-- > for i in [1, 2, 3]:
-- >     a[i] += 1
--
-- > b = range(10)
-- > for i in b:
-- >     a[i] += 1
--
-- > for i in range(0, 10, 2):
-- >     a[i] += 1
--
-- > for i, b_i in enumerate(b):
-- >     a[b_i] += i
--
-- For example, the followings don't have such assignments.
--
-- > c = 0
-- > for i in range(10):
-- >     a[c] += 1
--
-- > for i in range(10):
-- >     a[i] += 1
--
-- > for i in range(10):
-- >     a[i + 1] += 1
--
-- > for i in range(10):
-- >     for j in range(10):
-- >         a[i + 1][j] += 1
--
-- > for i in range(1, 10):
-- >     a[i] += 1
--
-- > for i, b_i in enumerate(b):
-- >     a[i] += b_i
hasNonTrivialSubscriptedAssignmentInForLoops :: Program -> Bool
hasNonTrivialSubscriptedAssignmentInForLoops :: Program -> Bool
hasNonTrivialSubscriptedAssignmentInForLoops Program
prog = (Statement -> Bool) -> [Statement] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Statement -> Bool
check (Program -> [Statement]
listStatements Program
prog)
  where
    check :: Statement -> Bool
check = \case
      AugAssign Target'
x Operator
_ WithLoc' Expr
_ -> Target' -> Bool
go Target'
x
      AnnAssign Target'
x Type
_ WithLoc' Expr
_ -> Target' -> Bool
go Target'
x
      Statement
_ -> Bool
False
    go :: Target' -> Bool
go (WithLoc' Maybe Loc
_ Target
x) = case Target
x of
      SubscriptTrg Target'
_ WithLoc' Expr
_ -> Bool
False -- TODO
      NameTrg VarName'
_ -> Bool
False
      TupleTrg [Target']
xs -> (Target' -> Bool) -> [Target'] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Target' -> Bool
go [Target']
xs

doesntHaveNonTrivialSubscriptedAssignmentInForLoops :: Program -> Bool
doesntHaveNonTrivialSubscriptedAssignmentInForLoops :: Program -> Bool
doesntHaveNonTrivialSubscriptedAssignmentInForLoops = Bool -> Bool
not (Bool -> Bool) -> (Program -> Bool) -> Program -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> Bool
hasMixedAssignment

ensureDoesntHaveNonTrivialSubscriptedAssignmentInForLoops :: MonadError Error m => Program -> m ()
ensureDoesntHaveNonTrivialSubscriptedAssignmentInForLoops :: Program -> m ()
ensureDoesntHaveNonTrivialSubscriptedAssignmentInForLoops = (Program -> Bool) -> String -> Program -> m ()
forall (m :: * -> *).
MonadError Error m =>
(Program -> Bool) -> String -> Program -> m ()
makeEnsureProgram Program -> Bool
doesntHaveNonTrivialSubscriptedAssignmentInForLoops String
"there must not be assignments with non-trivial subscriptions in for-loops"

-- | `hasAssginmentToBuiltin` checks that there are assignments to builtin functions.
-- For example, the followings have such assignments.
--
-- > map = 3
--
-- > return [range for range in range(10)]
hasAssignmentToBuiltin :: Program -> Bool
hasAssignmentToBuiltin :: Program -> Bool
hasAssignmentToBuiltin Program
_ = Bool
False -- TODO

doesntHaveAssignmentToBuiltin :: Program -> Bool
doesntHaveAssignmentToBuiltin :: Program -> Bool
doesntHaveAssignmentToBuiltin = Bool -> Bool
not (Bool -> Bool) -> (Program -> Bool) -> Program -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> Bool
hasAssignmentToBuiltin

ensureDoesntHaveAssignmentToBuiltin :: MonadError Error m => Program -> m ()
ensureDoesntHaveAssignmentToBuiltin :: Program -> m ()
ensureDoesntHaveAssignmentToBuiltin = (Program -> Bool) -> String -> Program -> m ()
forall (m :: * -> *).
MonadError Error m =>
(Program -> Bool) -> String -> Program -> m ()
makeEnsureProgram Program -> Bool
doesntHaveAssignmentToBuiltin String
"there must not be assignments to builtin functions"

-- | `hasNonResolvedBuiltin` checks that there are not resolved builtin functions.
-- This always doesn't hold after `Jikka.RestrictedPython.Language.Convert.ResolveBuiltin`.
hasNonResolvedBuiltin :: Program -> Bool
hasNonResolvedBuiltin :: Program -> Bool
hasNonResolvedBuiltin = (WithLoc' Expr -> Bool) -> [WithLoc' Expr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any WithLoc' Expr -> Bool
check ([WithLoc' Expr] -> Bool)
-> (Program -> [WithLoc' Expr]) -> Program -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> [WithLoc' Expr]
listExprs
  where
    check :: WithLoc' Expr -> Bool
check = (WithLoc' Expr -> Bool) -> [WithLoc' Expr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any WithLoc' Expr -> Bool
check' ([WithLoc' Expr] -> Bool)
-> (WithLoc' Expr -> [WithLoc' Expr]) -> WithLoc' Expr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithLoc' Expr -> [WithLoc' Expr]
listSubExprs
    check' :: WithLoc' Expr -> Bool
check' (WithLoc' Maybe Loc
_ Expr
e) = case Expr
e of
      Name VarName'
x | VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x VarName -> Set VarName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set VarName
builtinNames -> Bool
True
      Expr
_ -> Bool
False

doesntHaveNonResolvedBuiltin :: Program -> Bool
doesntHaveNonResolvedBuiltin :: Program -> Bool
doesntHaveNonResolvedBuiltin = Bool -> Bool
not (Bool -> Bool) -> (Program -> Bool) -> Program -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> Bool
hasAssignmentToBuiltin

ensureDoesntHaveNonResolvedBuiltin :: MonadError Error m => Program -> m ()
ensureDoesntHaveNonResolvedBuiltin :: Program -> m ()
ensureDoesntHaveNonResolvedBuiltin = (Program -> Bool) -> String -> Program -> m ()
forall (m :: * -> *).
MonadError Error m =>
(Program -> Bool) -> String -> Program -> m ()
makeEnsureProgram Program -> Bool
doesntHaveNonResolvedBuiltin String
"there must not be assignments to builtin functions"