{-
   Copyright 2016, Dominic Orchard, Andrew Rice, Mistral Contrastin, Matthew Danish

   Licensed under the Apache License, Version 2.0 (the "License");
   you may not use this file except in compliance with the License.
   You may obtain a copy of the License at

       http://www.apache.org/licenses/LICENSE-2.0

   Unless required by applicable law or agreed to in writing, software
   distributed under the License is distributed on an "AS IS" BASIS,
   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
   See the License for the specific language governing permissions and
   limitations under the License.
-}

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveGeneric #-}

{- Simple syntactic analysis on Fortran programs -}

module Camfort.Analysis.Simple
 ( countVariableDeclarations
 , checkImplicitNone
 , ImplicitNoneReport(..)
 , checkAllocateStatements
 , checkFloatingPointUse
 , checkModuleUse
 , checkArrayUse )
where

import Prelude hiding (unlines)
import Control.Monad
import Control.DeepSeq
import Data.Data
import Data.Function (on)
import Data.Maybe (catMaybes, fromMaybe, listToMaybe, mapMaybe)
import qualified Data.Set as S
import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import qualified Data.IntMap.Strict as IM
import qualified Data.Semigroup as SG
import Data.Monoid ((<>))
import Data.Generics.Uniplate.Operations
import qualified Data.Text.Lazy.Builder as Builder
import Data.Text (unlines, intercalate, pack)
import Data.List (sort, nub, nubBy, tails)
import GHC.Generics

import Data.Graph.Inductive

import qualified Language.Fortran.AST as F
import qualified Language.Fortran.Util.Position as F
import qualified Language.Fortran.Analysis as F
import qualified Language.Fortran.Analysis.DataFlow as F
import qualified Language.Fortran.Analysis.BBlocks as F
import Language.Fortran.Util.ModFile

import Camfort.Analysis (analysisModFiles,  ExitCodeOfReport(..), atSpanned, atSpannedInFile, Origin
                        , logError, describe, describeBuilder
                        , PureAnalysis, Describe )
import Camfort.Analysis.ModFile (withCombinedEnvironment)

{-| Counts the number of declarations (of variables) in a whole program -}

newtype VarCountReport = VarCountReport Int deriving (forall x. VarCountReport -> Rep VarCountReport x)
-> (forall x. Rep VarCountReport x -> VarCountReport)
-> Generic VarCountReport
forall x. Rep VarCountReport x -> VarCountReport
forall x. VarCountReport -> Rep VarCountReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VarCountReport x -> VarCountReport
$cfrom :: forall x. VarCountReport -> Rep VarCountReport x
Generic
instance NFData VarCountReport
instance ExitCodeOfReport VarCountReport where
  exitCodeOf :: VarCountReport -> Int
exitCodeOf VarCountReport
_ = Int
0
instance Describe VarCountReport where
  describeBuilder :: VarCountReport -> Builder
describeBuilder (VarCountReport Int
c) = Text -> Builder
Builder.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Describe a => a -> Text
describe Int
c

countVariableDeclarations :: forall a. Data a => F.ProgramFile a -> PureAnalysis () () VarCountReport
countVariableDeclarations :: ProgramFile a -> PureAnalysis () () VarCountReport
countVariableDeclarations ProgramFile a
pf = VarCountReport -> PureAnalysis () () VarCountReport
forall (m :: * -> *) a. Monad m => a -> m a
return (VarCountReport -> PureAnalysis () () VarCountReport)
-> (Int -> VarCountReport)
-> Int
-> PureAnalysis () () VarCountReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VarCountReport
VarCountReport (Int -> PureAnalysis () () VarCountReport)
-> Int -> PureAnalysis () () VarCountReport
forall a b. (a -> b) -> a -> b
$ [Declarator a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ProgramFile a -> [Declarator a]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile a
pf :: [F.Declarator a])

type PULoc = (F.ProgramUnitName, Origin)
data ImplicitNoneReport
  = ImplicitNoneReport [PULoc] -- ^ list of program units identified as needing implicit none
  deriving (forall x. ImplicitNoneReport -> Rep ImplicitNoneReport x)
-> (forall x. Rep ImplicitNoneReport x -> ImplicitNoneReport)
-> Generic ImplicitNoneReport
forall x. Rep ImplicitNoneReport x -> ImplicitNoneReport
forall x. ImplicitNoneReport -> Rep ImplicitNoneReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImplicitNoneReport x -> ImplicitNoneReport
$cfrom :: forall x. ImplicitNoneReport -> Rep ImplicitNoneReport x
Generic
instance NFData ImplicitNoneReport
instance SG.Semigroup ImplicitNoneReport where
  ImplicitNoneReport [PULoc]
r1 <> :: ImplicitNoneReport -> ImplicitNoneReport -> ImplicitNoneReport
<> ImplicitNoneReport [PULoc]
r2 = [PULoc] -> ImplicitNoneReport
ImplicitNoneReport ([PULoc] -> ImplicitNoneReport) -> [PULoc] -> ImplicitNoneReport
forall a b. (a -> b) -> a -> b
$ [PULoc]
r1 [PULoc] -> [PULoc] -> [PULoc]
forall a. [a] -> [a] -> [a]
++ [PULoc]
r2

instance Monoid ImplicitNoneReport where
  mempty :: ImplicitNoneReport
mempty = [PULoc] -> ImplicitNoneReport
ImplicitNoneReport []
  mappend :: ImplicitNoneReport -> ImplicitNoneReport -> ImplicitNoneReport
mappend = ImplicitNoneReport -> ImplicitNoneReport -> ImplicitNoneReport
forall a. Semigroup a => a -> a -> a
(SG.<>)

-- If allPU is False then function obeys host scoping unit rule:
-- 'external' program units (ie. appear at top level) must have
-- implicit-none statements, which are then inherited by internal
-- subprograms. Also, subprograms of interface blocks must have
-- implicit-none statements. If allPU is True then simply checks all
-- program units. FIXME: when we have Fortran 2008 support then
-- submodules must also be checked.
checkImplicitNone :: forall a. Data a => Bool -> F.ProgramFile a -> PureAnalysis String () ImplicitNoneReport
checkImplicitNone :: Bool -> ProgramFile a -> PureAnalysis String () ImplicitNoneReport
checkImplicitNone Bool
allPU ProgramFile a
pf = do
  [ImplicitNoneReport]
checkedPUs <- if Bool
allPU
                then [PureAnalysis String () ImplicitNoneReport]
-> AnalysisT String () Identity [ImplicitNoneReport]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ ProgramUnit a -> PureAnalysis String () ImplicitNoneReport
forall (m :: * -> *) e w.
MonadLogger e w m =>
ProgramUnit a -> m ImplicitNoneReport
puHelper ProgramUnit a
pu | ProgramUnit a
pu <- ProgramFile a -> [ProgramUnit a]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile a
pf :: [F.ProgramUnit a] ]
                     -- host scoping unit rule + interface exception:
                else [PureAnalysis String () ImplicitNoneReport]
-> AnalysisT String () Identity [ImplicitNoneReport]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ( [ ProgramUnit a -> PureAnalysis String () ImplicitNoneReport
forall (m :: * -> *) e w.
MonadLogger e w m =>
ProgramUnit a -> m ImplicitNoneReport
puHelper ProgramUnit a
pu | ProgramUnit a
pu <- ProgramFile a -> [ProgramUnit a]
forall from to. Biplate from to => from -> [to]
childrenBi ProgramFile a
pf :: [F.ProgramUnit a] ] [PureAnalysis String () ImplicitNoneReport]
-> [PureAnalysis String () ImplicitNoneReport]
-> [PureAnalysis String () ImplicitNoneReport]
forall a. [a] -> [a] -> [a]
++
                                [ ProgramUnit a -> PureAnalysis String () ImplicitNoneReport
forall (m :: * -> *) e w.
MonadLogger e w m =>
ProgramUnit a -> m ImplicitNoneReport
puHelper ProgramUnit a
pu | int :: Block a
int@(F.BlInterface {}) <- ProgramFile a -> [Block a]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile a
pf :: [F.Block a]
                                              , ProgramUnit a
pu <- Block a -> [ProgramUnit a]
forall from to. Biplate from to => from -> [to]
childrenBi Block a
int :: [F.ProgramUnit a] ] )
  [ImplicitNoneReport]
-> (ImplicitNoneReport -> AnalysisT String () Identity ())
-> AnalysisT String () Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ImplicitNoneReport]
checkedPUs ((ImplicitNoneReport -> AnalysisT String () Identity ())
 -> AnalysisT String () Identity ())
-> (ImplicitNoneReport -> AnalysisT String () Identity ())
-> AnalysisT String () Identity ()
forall a b. (a -> b) -> a -> b
$ \ ImplicitNoneReport
r -> case ImplicitNoneReport
r of
     ImplicitNoneReport [(F.Named String
name, Origin
orig)] -> Origin -> String -> AnalysisT String () Identity ()
forall e w (m :: * -> *). MonadLogger e w m => Origin -> e -> m ()
logError Origin
orig String
name
     ImplicitNoneReport
_ -> () -> AnalysisT String () Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  ImplicitNoneReport -> PureAnalysis String () ImplicitNoneReport
forall (m :: * -> *) a. Monad m => a -> m a
return (ImplicitNoneReport -> PureAnalysis String () ImplicitNoneReport)
-> ImplicitNoneReport -> PureAnalysis String () ImplicitNoneReport
forall a b. NFData a => (a -> b) -> a -> b
$!! [ImplicitNoneReport] -> ImplicitNoneReport
forall a. Monoid a => [a] -> a
mconcat [ImplicitNoneReport]
checkedPUs

  where
    isUseStmt :: Block a -> Bool
isUseStmt (F.BlStatement a
_ SrcSpan
_ Maybe (Expression a)
_ (F.StUse {})) = Bool
True
    isUseStmt Block a
_ = Bool
False
    isComment :: Block a -> Bool
isComment (F.BlComment {}) = Bool
True
    isComment Block a
_ = Bool
False
    isUseOrComment :: Block a -> Bool
isUseOrComment Block a
b = Block a -> Bool
forall a. Block a -> Bool
isUseStmt Block a
b Bool -> Bool -> Bool
|| Block a -> Bool
forall a. Block a -> Bool
isComment Block a
b

    isImplicitNone :: Block a -> Bool
isImplicitNone (F.BlStatement a
_ SrcSpan
_ Maybe (Expression a)
_ (F.StImplicit a
_ SrcSpan
_ Maybe (AList ImpList a)
Nothing)) = Bool
True; isImplicitNone Block a
_ = Bool
False
    isImplicitSome :: Block a -> Bool
isImplicitSome (F.BlStatement a
_ SrcSpan
_ Maybe (Expression a)
_ (F.StImplicit a
_ SrcSpan
_ (Just AList ImpList a
_))) = Bool
True; isImplicitSome Block a
_ = Bool
False

    checkPU :: F.ProgramUnit a -> Bool
    checkPU :: ProgramUnit a -> Bool
checkPU ProgramUnit a
pu = case ProgramUnit a
pu of
      F.PUMain a
_ SrcSpan
_ Maybe String
_ [Block a]
bs Maybe [ProgramUnit a]
_              -> [Block a] -> Bool
forall a. [Block a] -> Bool
checkBlocks [Block a]
bs
      F.PUModule a
_ SrcSpan
_ String
_ [Block a]
bs Maybe [ProgramUnit a]
_            -> [Block a] -> Bool
forall a. [Block a] -> Bool
checkBlocks [Block a]
bs
      F.PUSubroutine a
_ SrcSpan
_ PrefixSuffix a
_ String
_ Maybe (AList Expression a)
_ [Block a]
bs Maybe [ProgramUnit a]
_    -> [Block a] -> Bool
forall a. [Block a] -> Bool
checkBlocks [Block a]
bs
      F.PUFunction a
_ SrcSpan
_ Maybe (TypeSpec a)
_ PrefixSuffix a
_ String
_ Maybe (AList Expression a)
_ Maybe (Expression a)
_ [Block a]
bs Maybe [ProgramUnit a]
_  -> [Block a] -> Bool
forall a. [Block a] -> Bool
checkBlocks [Block a]
bs
      ProgramUnit a
_                                -> Bool
True

    checkBlocks :: [Block a] -> Bool
checkBlocks [Block a]
bs = (Block a -> Bool) -> [Block a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (Block a -> Bool) -> Block a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block a -> Bool
forall a. Block a -> Bool
isImplicitSome) [Block a]
bs Bool -> Bool -> Bool
&& (Block a -> Bool) -> [Block a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block a -> Bool
forall a. Block a -> Bool
isUseOrComment [Block a]
useStmts Bool -> Bool -> Bool
&& Bool -> Bool
not ([Block a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block a]
rest) Bool -> Bool -> Bool
&& (Block a -> Bool) -> [Block a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (Block a -> Bool) -> Block a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block a -> Bool
forall a. Block a -> Bool
isUseStmt) [Block a]
rest
      where
        ([Block a]
useStmts, [Block a]
rest) = (Block a -> Bool) -> [Block a] -> ([Block a], [Block a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block a -> Bool
forall a. Block a -> Bool
isImplicitNone [Block a]
bs

    puHelper :: ProgramUnit a -> m ImplicitNoneReport
puHelper ProgramUnit a
pu
      | ProgramUnit a -> Bool
checkPU ProgramUnit a
pu = ImplicitNoneReport -> m ImplicitNoneReport
forall (m :: * -> *) a. Monad m => a -> m a
return ImplicitNoneReport
forall a. Monoid a => a
mempty
      | Bool
otherwise = (Origin -> ImplicitNoneReport) -> m Origin -> m ImplicitNoneReport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ Origin
o -> [PULoc] -> ImplicitNoneReport
ImplicitNoneReport [(ProgramUnit a -> ProgramUnitName
forall a. Named a => a -> ProgramUnitName
F.getName ProgramUnit a
pu, Origin
o)]) (m Origin -> m ImplicitNoneReport)
-> m Origin -> m ImplicitNoneReport
forall a b. (a -> b) -> a -> b
$ ProgramUnit a -> m Origin
forall e w (m :: * -> *) a.
(MonadLogger e w m, Spanned a) =>
a -> m Origin
atSpanned ProgramUnit a
pu


instance Describe ImplicitNoneReport where
  describeBuilder :: ImplicitNoneReport -> Builder
describeBuilder (ImplicitNoneReport [PULoc]
results)
    | [PULoc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PULoc]
results = Builder
"no cases detected"
    | [PULoc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([PULoc] -> [PULoc]
forall a. [a] -> [a]
tail [PULoc]
results) = Builder
"1 case detected"
    | Bool
otherwise = Text -> Builder
Builder.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Describe a => a -> Text
describe ([PULoc] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PULoc]
results) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" cases detected"

instance ExitCodeOfReport ImplicitNoneReport where
  exitCodeOf :: ImplicitNoneReport -> Int
exitCodeOf (ImplicitNoneReport []) = Int
0
  exitCodeOf (ImplicitNoneReport [PULoc]
_)  = Int
1

--------------------------------------------------

data CheckAllocReport
  = CheckAllocReport { CheckAllocReport -> [(String, PULoc)]
unbalancedAllocs :: [(F.Name, PULoc)]
                     , CheckAllocReport -> [(String, PULoc)]
outOfOrder       :: [(F.Name, PULoc)]}
  deriving (forall x. CheckAllocReport -> Rep CheckAllocReport x)
-> (forall x. Rep CheckAllocReport x -> CheckAllocReport)
-> Generic CheckAllocReport
forall x. Rep CheckAllocReport x -> CheckAllocReport
forall x. CheckAllocReport -> Rep CheckAllocReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CheckAllocReport x -> CheckAllocReport
$cfrom :: forall x. CheckAllocReport -> Rep CheckAllocReport x
Generic
instance NFData CheckAllocReport
instance SG.Semigroup CheckAllocReport where
  CheckAllocReport [(String, PULoc)]
a1 [(String, PULoc)]
b1 <> :: CheckAllocReport -> CheckAllocReport -> CheckAllocReport
<> CheckAllocReport [(String, PULoc)]
a2 [(String, PULoc)]
b2 = [(String, PULoc)] -> [(String, PULoc)] -> CheckAllocReport
CheckAllocReport ([(String, PULoc)]
a1 [(String, PULoc)] -> [(String, PULoc)] -> [(String, PULoc)]
forall a. [a] -> [a] -> [a]
++ [(String, PULoc)]
a2) ([(String, PULoc)]
b1 [(String, PULoc)] -> [(String, PULoc)] -> [(String, PULoc)]
forall a. [a] -> [a] -> [a]
++ [(String, PULoc)]
b2)

instance Monoid CheckAllocReport where
  mempty :: CheckAllocReport
mempty = [(String, PULoc)] -> [(String, PULoc)] -> CheckAllocReport
CheckAllocReport [] []
  mappend :: CheckAllocReport -> CheckAllocReport -> CheckAllocReport
mappend = CheckAllocReport -> CheckAllocReport -> CheckAllocReport
forall a. Semigroup a => a -> a -> a
(SG.<>)

checkAllocateStatements :: forall a. Data a => F.ProgramFile a -> PureAnalysis String () CheckAllocReport
checkAllocateStatements :: ProgramFile a -> PureAnalysis String () CheckAllocReport
checkAllocateStatements ProgramFile a
pf = do
  let F.ProgramFile F.MetaInfo { miFilename :: MetaInfo -> String
F.miFilename = String
file } [ProgramUnit a]
_ = ProgramFile a
pf

  let checkPU :: F.ProgramUnit a -> CheckAllocReport
      checkPU :: ProgramUnit a -> CheckAllocReport
checkPU ProgramUnit a
pu = CheckAllocReport :: [(String, PULoc)] -> [(String, PULoc)] -> CheckAllocReport
CheckAllocReport {[(String, PULoc)]
outOfOrder :: [(String, PULoc)]
unbalancedAllocs :: [(String, PULoc)]
outOfOrder :: [(String, PULoc)]
unbalancedAllocs :: [(String, PULoc)]
..}
        where
          allocs :: [(String, PULoc)]
allocs =
            [ (String
v, (ProgramUnit a -> ProgramUnitName
forall a. Named a => a -> ProgramUnitName
F.getName ProgramUnit a
pu, String -> Expression a -> Origin
forall a. Spanned a => String -> a -> Origin
atSpannedInFile String
file Expression a
e))
            | F.StAllocate a
_ SrcSpan
_ Maybe (TypeSpec a)
_ (F.AList a
_ SrcSpan
_ [Expression a]
es) Maybe (AList AllocOpt a)
_ <- [Block a] -> [Statement a]
forall from to. Biplate from to => from -> [to]
universeBi (ProgramUnit a -> [Block a]
forall a. ProgramUnit a -> [Block a]
F.programUnitBody ProgramUnit a
pu) :: [F.Statement a]
            , Expression a
e <- [Expression a]
es
            , String
v <- Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 [ String
v | F.ExpValue a
_ SrcSpan
_ (F.ValVariable String
v) <- Expression a -> [Expression a]
forall from to. Biplate from to => from -> [to]
universeBi Expression a
e :: [F.Expression a] ]
            ]
          deallocs :: [(String, PULoc)]
deallocs =
            [ (String
v, (ProgramUnit a -> ProgramUnitName
forall a. Named a => a -> ProgramUnitName
F.getName ProgramUnit a
pu, String -> Expression a -> Origin
forall a. Spanned a => String -> a -> Origin
atSpannedInFile String
file Expression a
e))
            | F.StDeallocate a
_ SrcSpan
_ (F.AList a
_ SrcSpan
_ [Expression a]
es) Maybe (AList AllocOpt a)
_ <- [Block a] -> [Statement a]
forall from to. Biplate from to => from -> [to]
universeBi (ProgramUnit a -> [Block a]
forall a. ProgramUnit a -> [Block a]
F.programUnitBody ProgramUnit a
pu) :: [F.Statement a]
            , Expression a
e <- [Expression a]
es
            , String
v <- Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 [ String
v | F.ExpValue a
_ SrcSpan
_ (F.ValVariable String
v) <- Expression a -> [Expression a]
forall from to. Biplate from to => from -> [to]
universeBi Expression a
e :: [F.Expression a] ]
            ]
          isDealloced :: String -> Bool
isDealloced String
v = Bool -> Bool
not (Bool -> Bool)
-> ([(String, PULoc)] -> Bool) -> [(String, PULoc)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, PULoc)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(String, PULoc)] -> Bool) -> [(String, PULoc)] -> Bool
forall a b. (a -> b) -> a -> b
$ ((String, PULoc) -> Bool) -> [(String, PULoc)] -> [(String, PULoc)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
v) (String -> Bool)
-> ((String, PULoc) -> String) -> (String, PULoc) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, PULoc) -> String
forall a b. (a, b) -> a
fst) [(String, PULoc)]
deallocs
          unbalancedAllocs :: [(String, PULoc)]
unbalancedAllocs = ((String, PULoc) -> Bool) -> [(String, PULoc)] -> [(String, PULoc)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, PULoc) -> Bool) -> (String, PULoc) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isDealloced (String -> Bool)
-> ((String, PULoc) -> String) -> (String, PULoc) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, PULoc) -> String
forall a b. (a, b) -> a
fst) [(String, PULoc)]
allocs
          outOfOrder :: [(String, PULoc)]
outOfOrder = [[(String, PULoc)]] -> [(String, PULoc)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(String, PULoc)]] -> [(String, PULoc)])
-> [[(String, PULoc)]] -> [(String, PULoc)]
forall a b. (a -> b) -> a -> b
$ ((String, PULoc) -> (String, PULoc) -> [(String, PULoc)])
-> [(String, PULoc)] -> [(String, PULoc)] -> [[(String, PULoc)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ (String, PULoc)
v1 (String, PULoc)
v2 -> if (String, PULoc) -> String
forall a b. (a, b) -> a
fst (String, PULoc)
v1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (String, PULoc) -> String
forall a b. (a, b) -> a
fst (String, PULoc)
v2 then [] else [(String, PULoc)
v1, (String, PULoc)
v2]) (((String, PULoc) -> (String, PULoc) -> Bool)
-> [(String, PULoc)] -> [(String, PULoc)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> ((String, PULoc) -> String)
-> (String, PULoc)
-> (String, PULoc)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (String, PULoc) -> String
forall a b. (a, b) -> a
fst) [(String, PULoc)]
allocs) (((String, PULoc) -> (String, PULoc) -> Bool)
-> [(String, PULoc)] -> [(String, PULoc)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> ((String, PULoc) -> String)
-> (String, PULoc)
-> (String, PULoc)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (String, PULoc) -> String
forall a b. (a, b) -> a
fst) ([(String, PULoc)] -> [(String, PULoc)])
-> [(String, PULoc)] -> [(String, PULoc)]
forall a b. (a -> b) -> a -> b
$ [(String, PULoc)] -> [(String, PULoc)]
forall a. [a] -> [a]
reverse [(String, PULoc)]
deallocs)

  let reports :: [CheckAllocReport]
reports = (ProgramUnit a -> CheckAllocReport)
-> [ProgramUnit a] -> [CheckAllocReport]
forall a b. (a -> b) -> [a] -> [b]
map ProgramUnit a -> CheckAllocReport
checkPU (ProgramFile a -> [ProgramUnit a]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile a
pf)

  CheckAllocReport -> PureAnalysis String () CheckAllocReport
forall (m :: * -> *) a. Monad m => a -> m a
return (CheckAllocReport -> PureAnalysis String () CheckAllocReport)
-> CheckAllocReport -> PureAnalysis String () CheckAllocReport
forall a b. NFData a => (a -> b) -> a -> b
$!! [CheckAllocReport] -> CheckAllocReport
forall a. Monoid a => [a] -> a
mconcat [CheckAllocReport]
reports


instance Describe CheckAllocReport where
  describeBuilder :: CheckAllocReport -> Builder
describeBuilder (CheckAllocReport {[(String, PULoc)]
outOfOrder :: [(String, PULoc)]
unbalancedAllocs :: [(String, PULoc)]
outOfOrder :: CheckAllocReport -> [(String, PULoc)]
unbalancedAllocs :: CheckAllocReport -> [(String, PULoc)]
..})
    | [(String, PULoc)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(String, PULoc)]
unbalancedAllocs [(String, PULoc)] -> [(String, PULoc)] -> [(String, PULoc)]
forall a. [a] -> [a] -> [a]
++ [(String, PULoc)]
outOfOrder) = Builder
"no cases detected"
    | Bool
otherwise = Text -> Builder
Builder.fromText (Text -> Builder) -> ([Text] -> Text) -> [Text] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
unlines ([Text] -> Builder) -> [Text] -> Builder
forall a b. (a -> b) -> a -> b
$
      [ Origin -> Text
forall a. Describe a => a -> Text
describe Origin
orig Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" unbalanced allocation or deallocation for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack String
name
      | (String
name, (ProgramUnitName
_, Origin
orig)) <- [(String, PULoc)]
unbalancedAllocs ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
      [ Origin -> Text
forall a. Describe a => a -> Text
describe Origin
orig Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" out-of-order (de)allocation " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack String
name
      | (String
name, (ProgramUnitName
_, Origin
orig)) <- [(String, PULoc)]
outOfOrder ]

instance ExitCodeOfReport CheckAllocReport where
  exitCodeOf :: CheckAllocReport -> Int
exitCodeOf (CheckAllocReport {[(String, PULoc)]
outOfOrder :: [(String, PULoc)]
unbalancedAllocs :: [(String, PULoc)]
outOfOrder :: CheckAllocReport -> [(String, PULoc)]
unbalancedAllocs :: CheckAllocReport -> [(String, PULoc)]
..})
    | [(String, PULoc)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(String, PULoc)]
unbalancedAllocs [(String, PULoc)] -> [(String, PULoc)] -> [(String, PULoc)]
forall a. [a] -> [a] -> [a]
++ [(String, PULoc)]
outOfOrder) = Int
0
    | Bool
otherwise = Int
1

--------------------------------------------------

data CheckFPReport
  = CheckFPReport { CheckFPReport -> [PULoc]
badEquality :: [PULoc] }
  deriving (forall x. CheckFPReport -> Rep CheckFPReport x)
-> (forall x. Rep CheckFPReport x -> CheckFPReport)
-> Generic CheckFPReport
forall x. Rep CheckFPReport x -> CheckFPReport
forall x. CheckFPReport -> Rep CheckFPReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CheckFPReport x -> CheckFPReport
$cfrom :: forall x. CheckFPReport -> Rep CheckFPReport x
Generic
instance NFData CheckFPReport
instance SG.Semigroup CheckFPReport where
  CheckFPReport [PULoc]
a1 <> :: CheckFPReport -> CheckFPReport -> CheckFPReport
<> CheckFPReport [PULoc]
a2 = [PULoc] -> CheckFPReport
CheckFPReport ([PULoc]
a1 [PULoc] -> [PULoc] -> [PULoc]
forall a. [a] -> [a] -> [a]
++ [PULoc]
a2)

instance Monoid CheckFPReport where
  mempty :: CheckFPReport
mempty = [PULoc] -> CheckFPReport
CheckFPReport []
  mappend :: CheckFPReport -> CheckFPReport -> CheckFPReport
mappend = CheckFPReport -> CheckFPReport -> CheckFPReport
forall a. Semigroup a => a -> a -> a
(SG.<>)

checkFloatingPointUse :: forall a. Data a => F.ProgramFile a -> PureAnalysis String () CheckFPReport
checkFloatingPointUse :: ProgramFile a -> PureAnalysis String () CheckFPReport
checkFloatingPointUse ProgramFile a
pf = do
  let F.ProgramFile F.MetaInfo { miFilename :: MetaInfo -> String
F.miFilename = String
file } [ProgramUnit a]
_ = ProgramFile a
pf
  ModFiles
mfs <- AnalysisT String () Identity ModFiles
forall e w (m :: * -> *). MonadAnalysis e w m => m ModFiles
analysisModFiles
  let (ProgramFile (Analysis a)
pf', ModuleMap
_, TypeEnv
_) = ModFiles
-> ProgramFile a -> (ProgramFile (Analysis a), ModuleMap, TypeEnv)
forall a.
Data a =>
ModFiles
-> ProgramFile a -> (ProgramFile (Analysis a), ModuleMap, TypeEnv)
withCombinedEnvironment ModFiles
mfs ProgramFile a
pf
  let pvm :: ParamVarMap
pvm         = ModFiles -> ParamVarMap
combinedParamVarMap ModFiles
mfs
  let pf'' :: ProgramFile (Analysis a)
pf''        = ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
F.analyseConstExps (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> ProgramFile (Analysis a)
-> ProgramFile (Analysis a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParamVarMap -> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a.
Data a =>
ParamVarMap -> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
F.analyseParameterVars ParamVarMap
pvm (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> ProgramFile (Analysis a)
-> ProgramFile (Analysis a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
F.analyseBBlocks (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a b. (a -> b) -> a -> b
$ ProgramFile (Analysis a)
pf'

  let checkPU :: F.ProgramUnit (F.Analysis a) -> CheckFPReport
      checkPU :: ProgramUnit (Analysis a) -> CheckFPReport
checkPU ProgramUnit (Analysis a)
pu = CheckFPReport :: [PULoc] -> CheckFPReport
CheckFPReport {[PULoc]
badEquality :: [PULoc]
badEquality :: [PULoc]
..}
        where
          candidates :: [F.Expression (F.Analysis a)]
          candidates :: [Expression (Analysis a)]
candidates = [ Expression (Analysis a)
e | e :: Expression (Analysis a)
e@(F.ExpBinary Analysis a
_ SrcSpan
_ BinaryOp
op Expression (Analysis a)
x Expression (Analysis a)
y) <- [Block (Analysis a)] -> [Expression (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi (ProgramUnit (Analysis a) -> [Block (Analysis a)]
forall a. ProgramUnit a -> [Block a]
F.programUnitBody ProgramUnit (Analysis a)
pu)
                           , BinaryOp
op BinaryOp -> [BinaryOp] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BinaryOp
F.EQ, BinaryOp
F.NE]
                           , Just (F.IDType (Just BaseType
bt) Maybe ConstructType
_) <- [Analysis a -> Maybe IDType
forall a. Analysis a -> Maybe IDType
F.idType (Expression (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation Expression (Analysis a)
x), Analysis a -> Maybe IDType
forall a. Analysis a -> Maybe IDType
F.idType (Expression (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation Expression (Analysis a)
y)]
                           , BaseType
bt BaseType -> [BaseType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BaseType]
floatingPointTypes ]
          badEquality :: [PULoc]
badEquality = [PULoc] -> [PULoc]
forall a. Eq a => [a] -> [a]
nub [ (ProgramUnit (Analysis a) -> ProgramUnitName
forall a. Named a => a -> ProgramUnitName
F.getName ProgramUnit (Analysis a)
pu, String -> Expression (Analysis a) -> Origin
forall a. Spanned a => String -> a -> Origin
atSpannedInFile String
file Expression (Analysis a)
e) | Expression (Analysis a)
e <- [Expression (Analysis a)]
candidates ]

  let reports :: [CheckFPReport]
reports = (ProgramUnit (Analysis a) -> CheckFPReport)
-> [ProgramUnit (Analysis a)] -> [CheckFPReport]
forall a b. (a -> b) -> [a] -> [b]
map ProgramUnit (Analysis a) -> CheckFPReport
checkPU (ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile (Analysis a)
pf'')

  CheckFPReport -> PureAnalysis String () CheckFPReport
forall (m :: * -> *) a. Monad m => a -> m a
return (CheckFPReport -> PureAnalysis String () CheckFPReport)
-> CheckFPReport -> PureAnalysis String () CheckFPReport
forall a b. NFData a => (a -> b) -> a -> b
$!! [CheckFPReport] -> CheckFPReport
forall a. Monoid a => [a] -> a
mconcat [CheckFPReport]
reports

floatingPointTypes :: [F.BaseType]
floatingPointTypes :: [BaseType]
floatingPointTypes = [BaseType
F.TypeReal, BaseType
F.TypeDoubleComplex, BaseType
F.TypeComplex, BaseType
F.TypeDoublePrecision]

instance Describe CheckFPReport where
  describeBuilder :: CheckFPReport -> Builder
describeBuilder (CheckFPReport {[PULoc]
badEquality :: [PULoc]
badEquality :: CheckFPReport -> [PULoc]
..})
    | [PULoc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([PULoc]
badEquality) = Builder
"no cases detected"
    | Bool
otherwise = Text -> Builder
Builder.fromText (Text -> Builder) -> ([Text] -> Text) -> [Text] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
unlines ([Text] -> Builder) -> [Text] -> Builder
forall a b. (a -> b) -> a -> b
$
      [ Origin -> Text
forall a. Describe a => a -> Text
describe Origin
orig Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" equality operation used on floating-point numbers."
      | (ProgramUnitName
_, Origin
orig) <- [PULoc]
badEquality ]

instance ExitCodeOfReport CheckFPReport where
  exitCodeOf :: CheckFPReport -> Int
exitCodeOf (CheckFPReport {[PULoc]
badEquality :: [PULoc]
badEquality :: CheckFPReport -> [PULoc]
..})
    | [PULoc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([PULoc]
badEquality) = Int
0
    | Bool
otherwise = Int
1

--------------------------------------------------

data CheckUseReport
  = CheckUseReport { CheckUseReport -> [PULoc]
missingOnly :: [PULoc]
                   , CheckUseReport -> [(String, PULoc)]
duppedOnly  :: [(String, PULoc)]
                   , CheckUseReport -> [(String, PULoc)]
unusedNames :: [(String, PULoc)]
                   }
  deriving (forall x. CheckUseReport -> Rep CheckUseReport x)
-> (forall x. Rep CheckUseReport x -> CheckUseReport)
-> Generic CheckUseReport
forall x. Rep CheckUseReport x -> CheckUseReport
forall x. CheckUseReport -> Rep CheckUseReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CheckUseReport x -> CheckUseReport
$cfrom :: forall x. CheckUseReport -> Rep CheckUseReport x
Generic
instance NFData CheckUseReport
instance SG.Semigroup CheckUseReport where
  CheckUseReport [PULoc]
a1 [(String, PULoc)]
b1 [(String, PULoc)]
c1 <> :: CheckUseReport -> CheckUseReport -> CheckUseReport
<> CheckUseReport [PULoc]
a2 [(String, PULoc)]
b2 [(String, PULoc)]
c2 = [PULoc] -> [(String, PULoc)] -> [(String, PULoc)] -> CheckUseReport
CheckUseReport ([PULoc]
a1 [PULoc] -> [PULoc] -> [PULoc]
forall a. [a] -> [a] -> [a]
++ [PULoc]
a2) ([(String, PULoc)]
b1 [(String, PULoc)] -> [(String, PULoc)] -> [(String, PULoc)]
forall a. [a] -> [a] -> [a]
++ [(String, PULoc)]
b2) ([(String, PULoc)]
c1 [(String, PULoc)] -> [(String, PULoc)] -> [(String, PULoc)]
forall a. [a] -> [a] -> [a]
++ [(String, PULoc)]
c2)

instance Monoid CheckUseReport where
  mempty :: CheckUseReport
mempty = [PULoc] -> [(String, PULoc)] -> [(String, PULoc)] -> CheckUseReport
CheckUseReport [] [] []
  mappend :: CheckUseReport -> CheckUseReport -> CheckUseReport
mappend = CheckUseReport -> CheckUseReport -> CheckUseReport
forall a. Semigroup a => a -> a -> a
(SG.<>)

checkModuleUse :: forall a. Data a => F.ProgramFile a -> PureAnalysis String () CheckUseReport
checkModuleUse :: ProgramFile a -> PureAnalysis String () CheckUseReport
checkModuleUse ProgramFile a
pf = do
  let F.ProgramFile F.MetaInfo { miFilename :: MetaInfo -> String
F.miFilename = String
file } [ProgramUnit a]
_ = ProgramFile a
pf
  ModFiles
mfs <- AnalysisT String () Identity ModFiles
forall e w (m :: * -> *). MonadAnalysis e w m => m ModFiles
analysisModFiles
  let (ProgramFile (Analysis a)
pf', ModuleMap
_, TypeEnv
_) = ModFiles
-> ProgramFile a -> (ProgramFile (Analysis a), ModuleMap, TypeEnv)
forall a.
Data a =>
ModFiles
-> ProgramFile a -> (ProgramFile (Analysis a), ModuleMap, TypeEnv)
withCombinedEnvironment ModFiles
mfs ProgramFile a
pf

  let checkPU :: F.ProgramUnit (F.Analysis a) -> CheckUseReport
      checkPU :: ProgramUnit (Analysis a) -> CheckUseReport
checkPU ProgramUnit (Analysis a)
pu = CheckUseReport :: [PULoc] -> [(String, PULoc)] -> [(String, PULoc)] -> CheckUseReport
CheckUseReport {[(String, PULoc)]
[PULoc]
unusedNames :: [(String, PULoc)]
duppedOnly :: [(String, PULoc)]
missingOnly :: [PULoc]
unusedNames :: [(String, PULoc)]
duppedOnly :: [(String, PULoc)]
missingOnly :: [PULoc]
..}
        where
          statements :: [F.Statement (F.Analysis a)]
          statements :: [Statement (Analysis a)]
statements  = [Block (Analysis a)] -> [Statement (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi (ProgramUnit (Analysis a) -> [Block (Analysis a)]
forall a. ProgramUnit a -> [Block a]
F.programUnitBody ProgramUnit (Analysis a)
pu)
          expressions :: [F.Expression (F.Analysis a)]
          expressions :: [Expression (Analysis a)]
expressions = ProgramUnit (Analysis a) -> [Expression (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi ProgramUnit (Analysis a)
pu
          missingOnly :: [PULoc]
missingOnly = [PULoc] -> [PULoc]
forall a. Eq a => [a] -> [a]
nub [ (ProgramUnit (Analysis a) -> ProgramUnitName
forall a. Named a => a -> ProgramUnitName
F.getName ProgramUnit (Analysis a)
pu, String -> Statement (Analysis a) -> Origin
forall a. Spanned a => String -> a -> Origin
atSpannedInFile String
file Statement (Analysis a)
s)
                            | Statement (Analysis a)
s <- [ Statement (Analysis a)
s | s :: Statement (Analysis a)
s@(F.StUse Analysis a
_ SrcSpan
_ Expression (Analysis a)
_ Maybe ModuleNature
_ Only
F.Permissive Maybe (AList Use (Analysis a))
_) <- [Statement (Analysis a)]
statements ] ]
          duppedOnly :: [(String, PULoc)]
duppedOnly  = [ (String
n, (ProgramUnit (Analysis a) -> ProgramUnitName
forall a. Named a => a -> ProgramUnitName
F.getName ProgramUnit (Analysis a)
pu, String -> SrcSpan -> Origin
forall a. Spanned a => String -> a -> Origin
atSpannedInFile String
file (SrcSpan -> Origin) -> SrcSpan -> Origin
forall a b. (a -> b) -> a -> b
$ (SrcSpan, SrcSpan) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
F.getSpan (SrcSpan
ss, SrcSpan
ss')))
                        | F.StUse Analysis a
_ SrcSpan
ss (F.ExpValue Analysis a
_ SrcSpan
_ (F.ValVariable String
n)) Maybe ModuleNature
_ Only
_ Maybe (AList Use (Analysis a))
_:[Statement (Analysis a)]
rest <- [Statement (Analysis a)] -> [[Statement (Analysis a)]]
forall a. [a] -> [[a]]
tails [Statement (Analysis a)]
statements
                        , F.StUse Analysis a
_ SrcSpan
ss' (F.ExpValue Analysis a
_ SrcSpan
_ (F.ValVariable String
n')) Maybe ModuleNature
_ Only
_ Maybe (AList Use (Analysis a))
_ <- [Statement (Analysis a)]
rest
                        , String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n' ]
          extractUseName :: Use b -> (String, SrcSpan)
extractUseName (F.UseID b
_ SrcSpan
ss (F.ExpValue b
_ SrcSpan
_ (F.ValVariable String
n)))       = (String
n, SrcSpan
ss)
          extractUseName (F.UseRename b
_ SrcSpan
ss (F.ExpValue b
_ SrcSpan
_ (F.ValVariable String
n)) Expression b
_) = (String
n, SrcSpan
ss)
          extractUseName Use b
u = String -> (String, SrcSpan)
forall a. HasCallStack => String -> a
error (String -> (String, SrcSpan)) -> String -> (String, SrcSpan)
forall a b. (a -> b) -> a -> b
$ String
"checkModuleUse: extractUseName: invalid AST: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Use () -> String
forall a. Show a => a -> String
show ((b -> ()) -> Use b -> Use ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> b -> ()
forall a b. a -> b -> a
const ()) Use b
u)
          unusedNames :: [(String, PULoc)]
unusedNames = [ (String
n, (ProgramUnit (Analysis a) -> ProgramUnitName
forall a. Named a => a -> ProgramUnitName
F.getName ProgramUnit (Analysis a)
pu, String -> SrcSpan -> Origin
forall a. Spanned a => String -> a -> Origin
atSpannedInFile String
file SrcSpan
ss))
                        | F.StUse Analysis a
_ SrcSpan
_ Expression (Analysis a)
_ Maybe ModuleNature
_ Only
_ (Just (F.AList Analysis a
_ SrcSpan
_ [Use (Analysis a)]
uses)) <- [Statement (Analysis a)]
statements
                        , (String
n, SrcSpan
ss) <- (Use (Analysis a) -> (String, SrcSpan))
-> [Use (Analysis a)] -> [(String, SrcSpan)]
forall a b. (a -> b) -> [a] -> [b]
map Use (Analysis a) -> (String, SrcSpan)
forall b. Use b -> (String, SrcSpan)
extractUseName [Use (Analysis a)]
uses
                        , [()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Int -> [()] -> [()]
forall a. Int -> [a] -> [a]
drop Int
1 [ () | F.ExpValue Analysis a
_ SrcSpan
_ (F.ValVariable String
n') <- [Expression (Analysis a)]
expressions, String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n' ]) ]

  let reports :: [CheckUseReport]
reports = (ProgramUnit (Analysis a) -> CheckUseReport)
-> [ProgramUnit (Analysis a)] -> [CheckUseReport]
forall a b. (a -> b) -> [a] -> [b]
map ProgramUnit (Analysis a) -> CheckUseReport
checkPU (ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile (Analysis a)
pf')

  CheckUseReport -> PureAnalysis String () CheckUseReport
forall (m :: * -> *) a. Monad m => a -> m a
return (CheckUseReport -> PureAnalysis String () CheckUseReport)
-> CheckUseReport -> PureAnalysis String () CheckUseReport
forall a b. NFData a => (a -> b) -> a -> b
$!! [CheckUseReport] -> CheckUseReport
forall a. Monoid a => [a] -> a
mconcat [CheckUseReport]
reports

instance Describe CheckUseReport where
  describeBuilder :: CheckUseReport -> Builder
describeBuilder (CheckUseReport {[(String, PULoc)]
[PULoc]
unusedNames :: [(String, PULoc)]
duppedOnly :: [(String, PULoc)]
missingOnly :: [PULoc]
unusedNames :: CheckUseReport -> [(String, PULoc)]
duppedOnly :: CheckUseReport -> [(String, PULoc)]
missingOnly :: CheckUseReport -> [PULoc]
..})
    | [PULoc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PULoc]
missingOnly Bool -> Bool -> Bool
&& [(String, PULoc)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, PULoc)]
duppedOnly Bool -> Bool -> Bool
&& [(String, PULoc)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, PULoc)]
unusedNames = Builder
"no cases detected"
    | Bool
otherwise = Text -> Builder
Builder.fromText (Text -> Builder) -> ([Text] -> Text) -> [Text] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
unlines ([Text] -> Builder) -> [Text] -> Builder
forall a b. (a -> b) -> a -> b
$
      [ Origin -> Text
forall a. Describe a => a -> Text
describe Origin
orig Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" USE statement missing ONLY attribute."
      | (ProgramUnitName
_, Origin
orig) <- [PULoc]
missingOnly ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
      [ Origin -> Text
forall a. Describe a => a -> Text
describe Origin
orig Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" multiple USE statements for same module '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Describe a => a -> Text
describe String
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
      | (String
name, (ProgramUnitName
_, Origin
orig)) <- [(String, PULoc)]
duppedOnly ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
      [ Origin -> Text
forall a. Describe a => a -> Text
describe Origin
orig Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" local name '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Describe a => a -> Text
describe String
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' imported but unused in program unit."
      | (String
name, (ProgramUnitName
_, Origin
orig)) <- [(String, PULoc)]
unusedNames ]

instance ExitCodeOfReport CheckUseReport where
  exitCodeOf :: CheckUseReport -> Int
exitCodeOf (CheckUseReport {[(String, PULoc)]
[PULoc]
unusedNames :: [(String, PULoc)]
duppedOnly :: [(String, PULoc)]
missingOnly :: [PULoc]
unusedNames :: CheckUseReport -> [(String, PULoc)]
duppedOnly :: CheckUseReport -> [(String, PULoc)]
missingOnly :: CheckUseReport -> [PULoc]
..})
    | [PULoc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PULoc]
missingOnly Bool -> Bool -> Bool
&& [(String, PULoc)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, PULoc)]
duppedOnly Bool -> Bool -> Bool
&& [(String, PULoc)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, PULoc)]
unusedNames = Int
0
    | Bool
otherwise = Int
1

--------------------------------------------------

data CheckArrayReport
  = CheckArrayReport { CheckArrayReport -> [([String], PULoc)]
nestedIdx, CheckArrayReport -> [([String], PULoc)]
missingIdx :: [([String], PULoc)] }
  deriving (forall x. CheckArrayReport -> Rep CheckArrayReport x)
-> (forall x. Rep CheckArrayReport x -> CheckArrayReport)
-> Generic CheckArrayReport
forall x. Rep CheckArrayReport x -> CheckArrayReport
forall x. CheckArrayReport -> Rep CheckArrayReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CheckArrayReport x -> CheckArrayReport
$cfrom :: forall x. CheckArrayReport -> Rep CheckArrayReport x
Generic
instance NFData CheckArrayReport
instance SG.Semigroup CheckArrayReport where
  CheckArrayReport [([String], PULoc)]
a1 [([String], PULoc)]
b1 <> :: CheckArrayReport -> CheckArrayReport -> CheckArrayReport
<> CheckArrayReport [([String], PULoc)]
a2 [([String], PULoc)]
b2 = [([String], PULoc)] -> [([String], PULoc)] -> CheckArrayReport
CheckArrayReport ([([String], PULoc)]
a1 [([String], PULoc)] -> [([String], PULoc)] -> [([String], PULoc)]
forall a. [a] -> [a] -> [a]
++ [([String], PULoc)]
a2) ([([String], PULoc)]
b1 [([String], PULoc)] -> [([String], PULoc)] -> [([String], PULoc)]
forall a. [a] -> [a] -> [a]
++ [([String], PULoc)]
b2)

instance Monoid CheckArrayReport where
  mempty :: CheckArrayReport
mempty = [([String], PULoc)] -> [([String], PULoc)] -> CheckArrayReport
CheckArrayReport [] []
  mappend :: CheckArrayReport -> CheckArrayReport -> CheckArrayReport
mappend = CheckArrayReport -> CheckArrayReport -> CheckArrayReport
forall a. Semigroup a => a -> a -> a
(SG.<>)

-- Look at array subscripting, especially with regard to order of
-- indices and perhaps whether there is a missing data dependency on
-- an index variable (e.g. due to copy/paste error).
checkArrayUse :: forall a. Data a => F.ProgramFile a -> PureAnalysis String () CheckArrayReport
checkArrayUse :: ProgramFile a -> PureAnalysis String () CheckArrayReport
checkArrayUse ProgramFile a
pf = do
  let F.ProgramFile F.MetaInfo { miFilename :: MetaInfo -> String
F.miFilename = String
file } [ProgramUnit a]
_ = ProgramFile a
pf
  ModFiles
mfs <- AnalysisT String () Identity ModFiles
forall e w (m :: * -> *). MonadAnalysis e w m => m ModFiles
analysisModFiles
  let (ProgramFile (Analysis a)
pf', ModuleMap
_, TypeEnv
_) = ModFiles
-> ProgramFile a -> (ProgramFile (Analysis a), ModuleMap, TypeEnv)
forall a.
Data a =>
ModFiles
-> ProgramFile a -> (ProgramFile (Analysis a), ModuleMap, TypeEnv)
withCombinedEnvironment ModFiles
mfs ProgramFile a
pf
  let pvm :: ParamVarMap
pvm         = ModFiles -> ParamVarMap
combinedParamVarMap ModFiles
mfs
  let pf'' :: ProgramFile (Analysis a)
pf''        = ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
F.analyseConstExps (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> ProgramFile (Analysis a)
-> ProgramFile (Analysis a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParamVarMap -> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a.
Data a =>
ParamVarMap -> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
F.analyseParameterVars ParamVarMap
pvm (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> ProgramFile (Analysis a)
-> ProgramFile (Analysis a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
F.analyseBBlocks (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a b. (a -> b) -> a -> b
$ ProgramFile (Analysis a)
pf'
  let bm :: BlockMap a
bm          = ProgramFile (Analysis a) -> BlockMap a
forall a. Data a => ProgramFile (Analysis a) -> BlockMap a
F.genBlockMap ProgramFile (Analysis a)
pf''
  let dm :: DefMap
dm          = BlockMap a -> DefMap
forall a. Data a => BlockMap a -> DefMap
F.genDefMap BlockMap a
bm

  let checkPU :: F.ProgramUnit (F.Analysis a) -> CheckArrayReport
      checkPU :: ProgramUnit (Analysis a) -> CheckArrayReport
checkPU ProgramUnit (Analysis a)
pu | F.Analysis { bBlocks :: forall a. Analysis a -> Maybe (BBGr (Analysis a))
F.bBlocks = Just BBGr (Analysis a)
_ } <- ProgramUnit (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation ProgramUnit (Analysis a)
pu = CheckArrayReport :: [([String], PULoc)] -> [([String], PULoc)] -> CheckArrayReport
CheckArrayReport {[([String], PULoc)]
missingIdx :: [([String], PULoc)]
nestedIdx :: [([String], PULoc)]
missingIdx :: [([String], PULoc)]
nestedIdx :: [([String], PULoc)]
..}
        where
          F.Analysis { bBlocks :: forall a. Analysis a -> Maybe (BBGr (Analysis a))
F.bBlocks = Just BBGr (Analysis a)
gr } = ProgramUnit (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation ProgramUnit (Analysis a)
pu
          bedges :: BackEdgeMap
bedges = DomMap -> Gr (BB (Analysis a)) () -> BackEdgeMap
forall (gr :: * -> * -> *) a b.
Graph gr =>
DomMap -> gr a b -> BackEdgeMap
F.genBackEdgeMap (BBGr (Analysis a) -> DomMap
forall a. BBGr a -> DomMap
F.dominators BBGr (Analysis a)
gr) (Gr (BB (Analysis a)) () -> BackEdgeMap)
-> Gr (BB (Analysis a)) () -> BackEdgeMap
forall a b. (a -> b) -> a -> b
$ BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
F.bbgrGr BBGr (Analysis a)
gr
          ivmap :: InductionVarMapByASTBlock
ivmap  = BackEdgeMap -> BBGr (Analysis a) -> InductionVarMapByASTBlock
forall a.
Data a =>
BackEdgeMap -> BBGr (Analysis a) -> InductionVarMapByASTBlock
F.genInductionVarMapByASTBlock BackEdgeMap
bedges BBGr (Analysis a)
gr
          rdmap :: InOutMap ASTBlockNodeSet
rdmap  = DefMap -> BBGr (Analysis a) -> InOutMap ASTBlockNodeSet
forall a.
Data a =>
DefMap -> BBGr (Analysis a) -> InOutMap ASTBlockNodeSet
F.reachingDefinitions DefMap
dm BBGr (Analysis a)
gr
          flTo :: FlowsGraph a
flTo   = BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> InOutMap ASTBlockNodeSet
-> FlowsGraph a
forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> InOutMap ASTBlockNodeSet
-> FlowsGraph a
F.genFlowsToGraph BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr InOutMap ASTBlockNodeSet
rdmap
          flFrom :: FlowsGraph a
flFrom = FlowsGraph a -> FlowsGraph a
forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> gr a b
grev FlowsGraph a
flTo

          blocks :: [F.Block (F.Analysis a)]
          blocks :: BB (Analysis a)
blocks = ProgramUnit (Analysis a) -> BB (Analysis a)
forall a. ProgramUnit a -> [Block a]
F.programUnitBody ProgramUnit (Analysis a)
pu

          nestedIdx :: [([String], PULoc)]
nestedIdx = [ ([String]
ivars, (ProgramUnit (Analysis a) -> ProgramUnitName
forall a. Named a => a -> ProgramUnitName
F.getName ProgramUnit (Analysis a)
pu, String -> SrcSpan -> Origin
forall a. Spanned a => String -> a -> Origin
atSpannedInFile String
file SrcSpan
ss)) | ([String]
ivars, SrcSpan
ss) <- [String] -> BB (Analysis a) -> [([String], SrcSpan)]
getNestedIdx [] BB (Analysis a)
blocks ]

          -- find subscripts where the order of indices doesn't match
          -- the order of introduction of induction variables by
          -- nested do-loops.
          getNestedIdx :: [F.Name] -> [F.Block (F.Analysis a)] -> [([String], F.SrcSpan)]
          getNestedIdx :: [String] -> BB (Analysis a) -> [([String], SrcSpan)]
getNestedIdx [String]
_ [] = []
          getNestedIdx [String]
vs (b :: Block (Analysis a)
b@(F.BlDo Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ Maybe String
_ Maybe (Expression (Analysis a))
_ Maybe (DoSpecification (Analysis a))
_ BB (Analysis a)
body Maybe (Expression (Analysis a))
_):BB (Analysis a)
bs)
            | String
v:[String]
_ <- Block (Analysis a) -> [String]
forall a. Data a => Block (Analysis a) -> [String]
F.blockVarDefs Block (Analysis a)
b = [String] -> BB (Analysis a) -> [([String], SrcSpan)]
getNestedIdx (String
vString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
vs) BB (Analysis a)
body [([String], SrcSpan)]
-> [([String], SrcSpan)] -> [([String], SrcSpan)]
forall a. [a] -> [a] -> [a]
++ [String] -> BB (Analysis a) -> [([String], SrcSpan)]
getNestedIdx [String]
vs BB (Analysis a)
bs
            | Bool
otherwise               = [String] -> BB (Analysis a) -> [([String], SrcSpan)]
getNestedIdx [String]
vs BB (Analysis a)
bs
          getNestedIdx [String]
vs (Block (Analysis a)
b:BB (Analysis a)
bs) = [([String], SrcSpan)]
bad [([String], SrcSpan)]
-> [([String], SrcSpan)] -> [([String], SrcSpan)]
forall a. [a] -> [a] -> [a]
++ [String] -> BB (Analysis a) -> [([String], SrcSpan)]
getNestedIdx [String]
vs BB (Analysis a)
bs
            where
              vset :: Set String
vset = [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList [String]
vs
              vmap :: [(String, Int)]
vmap = [String] -> [Int] -> [(String, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
vs ([Int
0..] :: [Int])
              subs :: [([(String, String)], SrcSpan)]
subs = [ ([(String, String)]
ivars, SrcSpan
ss)
                     | F.ExpSubscript Analysis a
_ SrcSpan
ss Expression (Analysis a)
_ (F.AList Analysis a
_ SrcSpan
_ [Index (Analysis a)]
is) <- Block (Analysis a) -> [Expression (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi Block (Analysis a)
b :: [F.Expression (F.Analysis a)]
                     , let ivars :: [(String, String)]
ivars = [ (Expression (Analysis a) -> String
forall a. Expression (Analysis a) -> String
F.varName Expression (Analysis a)
e, Expression (Analysis a) -> String
forall a. Expression (Analysis a) -> String
F.srcName Expression (Analysis a)
e)
                                   | Index (Analysis a)
i <- [Index (Analysis a)]
is
                                   , e :: Expression (Analysis a)
e@(F.ExpValue Analysis a
_ SrcSpan
_ F.ValVariable{}) <- Index (Analysis a) -> [Expression (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi Index (Analysis a)
i :: [F.Expression (F.Analysis a)]
                                   , Expression (Analysis a) -> String
forall a. Expression (Analysis a) -> String
F.varName Expression (Analysis a)
e String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set String
vset ] ]
              -- 'bad' subscripts are where the ordering doesn't match the nesting.
              bad :: [([String], SrcSpan)]
bad = [ (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd [(String, String)]
ivars, SrcSpan
ss)
                    | ([(String, String)]
ivars, SrcSpan
ss) <- [([(String, String)], SrcSpan)]
subs, let nums :: [Int]
nums = ((String, String) -> Maybe Int) -> [(String, String)] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((String -> [(String, Int)] -> Maybe Int)
-> [(String, Int)] -> String -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [(String, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(String, Int)]
vmap (String -> Maybe Int)
-> ((String, String) -> String) -> (String, String) -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
ivars, [Int]
nums [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [Int]
nums ]

          missingIdx :: [([String], PULoc)]
missingIdx = [ ([String]
missing, (ProgramUnit (Analysis a) -> ProgramUnitName
forall a. Named a => a -> ProgramUnitName
F.getName ProgramUnit (Analysis a)
pu, String -> SrcSpan -> Origin
forall a. Spanned a => String -> a -> Origin
atSpannedInFile String
file SrcSpan
ss)) | Block (Analysis a)
b <- BB (Analysis a)
blocks
                                                                            , ([String]
missing, SrcSpan
ss) <- [String] -> Block (Analysis a) -> [([String], SrcSpan)]
forall a'.
Data a' =>
[String] -> Block (Analysis a') -> [([String], SrcSpan)]
getMissingUse [] Block (Analysis a)
b ]

          -- Seek any possible missing uses of an induction variable
          -- within subscript expressions, looking through nested
          -- blocks. We can exclude variables for which If/Case
          -- control-flow depends on it instead of needing it to be
          -- directly used by a subscript expression.
          getMissingUse :: forall a'. Data a' => [String] -> F.Block (F.Analysis a') -> [([String], F.SrcSpan)]
          getMissingUse :: [String] -> Block (Analysis a') -> [([String], SrcSpan)]
getMissingUse [String]
excls (F.BlDo Analysis a'
_ SrcSpan
_ Maybe (Expression (Analysis a'))
_ Maybe String
_ Maybe (Expression (Analysis a'))
_ Maybe (DoSpecification (Analysis a'))
_ [Block (Analysis a')]
bs Maybe (Expression (Analysis a'))
_)      = (Block (Analysis a') -> [([String], SrcSpan)])
-> [Block (Analysis a')] -> [([String], SrcSpan)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> Block (Analysis a') -> [([String], SrcSpan)]
forall a'.
Data a' =>
[String] -> Block (Analysis a') -> [([String], SrcSpan)]
getMissingUse [String]
excls) [Block (Analysis a')]
bs
          getMissingUse [String]
excls (F.BlDoWhile Analysis a'
_ SrcSpan
_ Maybe (Expression (Analysis a'))
_ Maybe String
_ Maybe (Expression (Analysis a'))
_ Expression (Analysis a')
_ [Block (Analysis a')]
bs Maybe (Expression (Analysis a'))
_) = (Block (Analysis a') -> [([String], SrcSpan)])
-> [Block (Analysis a')] -> [([String], SrcSpan)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> Block (Analysis a') -> [([String], SrcSpan)]
forall a'.
Data a' =>
[String] -> Block (Analysis a') -> [([String], SrcSpan)]
getMissingUse [String]
excls) [Block (Analysis a')]
bs
          getMissingUse [String]
excls (F.BlForall Analysis a'
_ SrcSpan
_ Maybe (Expression (Analysis a'))
_ Maybe String
_ ForallHeader (Analysis a')
_ [Block (Analysis a')]
bs Maybe (Expression (Analysis a'))
_)    = (Block (Analysis a') -> [([String], SrcSpan)])
-> [Block (Analysis a')] -> [([String], SrcSpan)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> Block (Analysis a') -> [([String], SrcSpan)]
forall a'.
Data a' =>
[String] -> Block (Analysis a') -> [([String], SrcSpan)]
getMissingUse [String]
excls) [Block (Analysis a')]
bs
          getMissingUse [String]
excls b :: Block (Analysis a')
b@(F.BlIf F.Analysis{insLabel :: forall a. Analysis a -> Maybe Int
F.insLabel = Just Int
i} SrcSpan
_ Maybe (Expression (Analysis a'))
_ Maybe String
_ [Maybe (Expression (Analysis a'))]
mes [[Block (Analysis a')]]
bss Maybe (Expression (Analysis a'))
_)
            -- check If statement conditions
            | (Expression (Analysis a') -> Bool)
-> [Expression (Analysis a')] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Expression (Analysis a') -> Bool
forall a' (b' :: * -> *).
(Data a', Data (b' (Analysis a'))) =>
Int -> Int -> b' (Analysis a') -> Bool
eligible Int
i ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
excls)) [Expression (Analysis a')]
es = [([String], SrcSpan)]
bads [([String], SrcSpan)]
-> [([String], SrcSpan)] -> [([String], SrcSpan)]
forall a. [a] -> [a] -> [a]
++ [([String], SrcSpan)]
rest
            | Bool
otherwise                          = [([String], SrcSpan)]
rest
            where
              es :: [Expression (Analysis a')]
es = [Maybe (Expression (Analysis a'))] -> [Expression (Analysis a')]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Expression (Analysis a'))]
mes
              -- find any induction variables that are referenced by If-Elseif expressions
              excl' :: [String]
excl' = Block (Analysis a') -> [String]
forall (f :: * -> *) a. Annotated f => f (Analysis a) -> [String]
getExcludes Block (Analysis a')
b
              rest :: [([String], SrcSpan)]
rest = (Block (Analysis a') -> [([String], SrcSpan)])
-> [Block (Analysis a')] -> [([String], SrcSpan)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> Block (Analysis a') -> [([String], SrcSpan)]
forall a'.
Data a' =>
[String] -> Block (Analysis a') -> [([String], SrcSpan)]
getMissingUse ([String]
excls [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
excl')) ([Block (Analysis a')] -> [([String], SrcSpan)])
-> [Block (Analysis a')] -> [([String], SrcSpan)]
forall a b. (a -> b) -> a -> b
$ [[Block (Analysis a')]] -> [Block (Analysis a')]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Block (Analysis a')]]
bss
              bads :: [([String], SrcSpan)]
bads = [String] -> Block (Analysis a') -> [([String], SrcSpan)]
forall a'.
Data a' =>
[String] -> Block (Analysis a') -> [([String], SrcSpan)]
getMissingUse' [String]
excls Block (Analysis a')
b
          getMissingUse [String]
excls b :: Block (Analysis a')
b@(F.BlCase F.Analysis{insLabel :: forall a. Analysis a -> Maybe Int
F.insLabel = Just Int
i} SrcSpan
_ Maybe (Expression (Analysis a'))
_ Maybe String
_ Expression (Analysis a')
e [Maybe (AList Index (Analysis a'))]
_ [[Block (Analysis a')]]
bss Maybe (Expression (Analysis a'))
_)
            -- check Case statement scrutinee
            | Int -> Int -> Expression (Analysis a') -> Bool
forall a' (b' :: * -> *).
(Data a', Data (b' (Analysis a'))) =>
Int -> Int -> b' (Analysis a') -> Bool
eligible Int
i ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
excls) Expression (Analysis a')
e = [([String], SrcSpan)]
bads [([String], SrcSpan)]
-> [([String], SrcSpan)] -> [([String], SrcSpan)]
forall a. [a] -> [a] -> [a]
++ [([String], SrcSpan)]
rest
            | Bool
otherwise                   = [([String], SrcSpan)]
rest
            where
              rest :: [([String], SrcSpan)]
rest = (Block (Analysis a') -> [([String], SrcSpan)])
-> [Block (Analysis a')] -> [([String], SrcSpan)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> Block (Analysis a') -> [([String], SrcSpan)]
forall a'.
Data a' =>
[String] -> Block (Analysis a') -> [([String], SrcSpan)]
getMissingUse ([String]
excls [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Block (Analysis a') -> [String]
forall (f :: * -> *) a. Annotated f => f (Analysis a) -> [String]
getExcludes Block (Analysis a')
b)) ([Block (Analysis a')] -> [([String], SrcSpan)])
-> [Block (Analysis a')] -> [([String], SrcSpan)]
forall a b. (a -> b) -> a -> b
$ [[Block (Analysis a')]] -> [Block (Analysis a')]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Block (Analysis a')]]
bss
              bads :: [([String], SrcSpan)]
bads = (([String], SrcSpan) -> ([String], SrcSpan))
-> [([String], SrcSpan)] -> [([String], SrcSpan)]
forall a b. (a -> b) -> [a] -> [b]
map ((SrcSpan -> SrcSpan) -> ([String], SrcSpan) -> ([String], SrcSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpan -> SrcSpan -> SrcSpan
forall a b. a -> b -> a
const (Expression (Analysis a') -> SrcSpan
forall a. Spanned a => a -> SrcSpan
F.getSpan Expression (Analysis a')
e))) ([([String], SrcSpan)] -> [([String], SrcSpan)])
-> [([String], SrcSpan)] -> [([String], SrcSpan)]
forall a b. (a -> b) -> a -> b
$ [String] -> Block (Analysis a') -> [([String], SrcSpan)]
forall a'.
Data a' =>
[String] -> Block (Analysis a') -> [([String], SrcSpan)]
getMissingUse' [String]
excls Block (Analysis a')
b
          getMissingUse [String]
excls b :: Block (Analysis a')
b@(F.BlStatement F.Analysis{insLabel :: forall a. Analysis a -> Maybe Int
F.insLabel = Just Int
i} SrcSpan
_ Maybe (Expression (Analysis a'))
_ Statement (Analysis a')
st)
            | Int -> Int -> Statement (Analysis a') -> Bool
forall a' (b' :: * -> *).
(Data a', Data (b' (Analysis a'))) =>
Int -> Int -> b' (Analysis a') -> Bool
eligible Int
i ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
excls) Statement (Analysis a')
st = [String] -> Block (Analysis a') -> [([String], SrcSpan)]
forall a'.
Data a' =>
[String] -> Block (Analysis a') -> [([String], SrcSpan)]
getMissingUse' [String]
excls Block (Analysis a')
b
            | Bool
otherwise                    = []
          getMissingUse [String]
_ F.BlInterface{}  = []
          getMissingUse [String]
_ F.BlComment{}    = []
          getMissingUse [String]
_ Block (Analysis a')
b = String -> [([String], SrcSpan)]
forall a. HasCallStack => String -> a
error (String -> [([String], SrcSpan)])
-> String -> [([String], SrcSpan)]
forall a b. (a -> b) -> a -> b
$ String
"checkArrayUse: getMissingUse: missing insLabel: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Block (Maybe Int) -> String
forall a. Show a => a -> String
show ((Analysis a' -> Maybe Int)
-> Block (Analysis a') -> Block (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Analysis a' -> Maybe Int
forall a. Analysis a -> Maybe Int
F.insLabel Block (Analysis a')
b)

          getMissingUse' :: forall a'. Data a' => [F.Name] -> F.Block (F.Analysis a') -> [([F.Name], F.SrcSpan)]
          getMissingUse' :: [String] -> Block (Analysis a') -> [([String], SrcSpan)]
getMissingUse' [String]
excls Block (Analysis a')
b
            | Just Int
i            <- Analysis a' -> Maybe Int
forall a. Analysis a -> Maybe Int
F.insLabel (Block (Analysis a') -> Analysis a'
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation Block (Analysis a')
b)
            -- obtain the live induction variables at this program point
            , Just Set String
ivarSet      <- Int -> InductionVarMapByASTBlock -> Maybe (Set String)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i InductionVarMapByASTBlock
ivmap
            -- find the definitions that flowed into this program point
            , [Int]
flFroms           <- Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> FlowsGraph a -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> [Int]
bfs Int
i FlowsGraph a
flFrom
            -- get their AST Blocks
            , Just BB (Analysis a)
flFromBlocks <- [Maybe (Block (Analysis a))] -> Maybe (BB (Analysis a))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe (Block (Analysis a))] -> Maybe (BB (Analysis a)))
-> [Maybe (Block (Analysis a))] -> Maybe (BB (Analysis a))
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe (Block (Analysis a)))
-> [Int] -> [Maybe (Block (Analysis a))]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> BlockMap a -> Maybe (Block (Analysis a)))
-> BlockMap a -> Int -> Maybe (Block (Analysis a))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> BlockMap a -> Maybe (Block (Analysis a))
forall a. Int -> IntMap a -> Maybe a
IM.lookup BlockMap a
bm) [Int]
flFroms
            -- find out what variables they define
            , Set String
flFromBlockDefSet <- [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$ (Block (Analysis a) -> [String]) -> BB (Analysis a) -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block (Analysis a) -> [String]
forall a. Data a => Block (Analysis a) -> [String]
F.blockVarDefs BB (Analysis a)
flFromBlocks
            -- subtract the excludes and the defined variables from
            -- the live induction variables in order to find out the
            -- 'missing' or unaccounted-for induction vars.
            , Set String
missingIVars      <- Set String
ivarSet Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList [String]
excls Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set String
flFromBlockDefSet
            -- Try to look up source-names for the missing ivars in
            -- each of the flow-from blocks.
            , Set String
missingIVars'     <- (String -> String) -> Set String -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (\ String
v -> String
"unk" String -> Maybe String -> String
forall a. a -> Maybe a -> a
`fromMaybe` String -> Maybe String
findSrcNameInDefMap String
v) Set String
missingIVars
            , Bool -> Bool
not (Set String -> Bool
forall a. Set a -> Bool
S.null Set String
missingIVars) = [(Set String -> [String]
forall a. Set a -> [a]
S.toList Set String
missingIVars', Block (Analysis a') -> SrcSpan
forall a. Spanned a => a -> SrcSpan
F.getSpan Block (Analysis a')
b)]
          getMissingUse' [String]
_ Block (Analysis a')
_ = []

          -- eligible bits of AST are those that contain subscripting
          -- expressions with a length equivalent to the number of
          -- currently live induction variables.
          eligible :: forall a' b'. (Data a', Data (b' (F.Analysis a'))) => Int -> Int -> b' (F.Analysis a') -> Bool
          eligible :: Int -> Int -> b' (Analysis a') -> Bool
eligible Int
i Int
numExcls b' (Analysis a')
x
            | Just Set String
ivars <- Int -> InductionVarMapByASTBlock -> Maybe (Set String)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i InductionVarMapByASTBlock
ivmap =
                Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ () | F.ExpSubscript Analysis a'
_ SrcSpan
_ Expression (Analysis a')
_ (F.AList Analysis a'
_ SrcSpan
_ [Index (Analysis a')]
idxs) <- b' (Analysis a') -> [Expression (Analysis a')]
forall from to. Biplate from to => from -> [to]
universeBi b' (Analysis a')
x :: [F.Expression (F.Analysis a')]
                                , [Index (Analysis a')] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Index (Analysis a')]
idxs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Set String -> Int
forall a. Set a -> Int
S.size Set String
ivars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numExcls ]
            | Bool
otherwise = Bool
False

          -- check the derived induction maps to find out if a given
          -- expression depends on any induction variable and
          -- therefore can be used to exclude that induction variable
          -- from the 'missing' list.
          getExcludes :: f (Analysis a) -> [String]
getExcludes f (Analysis a)
b
            | Just Int
i            <- Analysis a -> Maybe Int
forall a. Analysis a -> Maybe Int
F.insLabel (f (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation f (Analysis a)
b)
            -- obtain the live induction variables at this program point
            , Just Set String
ivarSet      <- Int -> InductionVarMapByASTBlock -> Maybe (Set String)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i InductionVarMapByASTBlock
ivmap
            -- find the definitions that flowed into this program point
            , [Int]
flFroms           <- Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> FlowsGraph a -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> [Int]
bfs Int
i FlowsGraph a
flFrom
            -- get their AST Blocks
            , Just BB (Analysis a)
flFromBlocks <- [Maybe (Block (Analysis a))] -> Maybe (BB (Analysis a))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe (Block (Analysis a))] -> Maybe (BB (Analysis a)))
-> [Maybe (Block (Analysis a))] -> Maybe (BB (Analysis a))
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe (Block (Analysis a)))
-> [Int] -> [Maybe (Block (Analysis a))]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> BlockMap a -> Maybe (Block (Analysis a)))
-> BlockMap a -> Int -> Maybe (Block (Analysis a))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> BlockMap a -> Maybe (Block (Analysis a))
forall a. Int -> IntMap a -> Maybe a
IM.lookup BlockMap a
bm) [Int]
flFroms
            -- find out what variables they define
            , Set String
flFromBlockDefSet <- [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$ (Block (Analysis a) -> [String]) -> BB (Analysis a) -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block (Analysis a) -> [String]
forall a. Data a => Block (Analysis a) -> [String]
F.blockVarDefs BB (Analysis a)
flFromBlocks
            = Set String -> [String]
forall a. Set a -> [a]
S.toList (Set String
ivarSet Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
`S.intersection` Set String
flFromBlockDefSet)
            | Bool
otherwise = []

          -- look through the DefMap and BlockMap for instances of
          -- variable v in order to retrieve its 'source name'.
          findSrcNameInDefMap :: String -> Maybe String
findSrcNameInDefMap String
v = do
            ASTBlockNodeSet
defSet <- String -> DefMap -> Maybe ASTBlockNodeSet
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
v DefMap
dm
            BB (Analysis a)
bs     <- (Int -> Maybe (Block (Analysis a)))
-> [Int] -> Maybe (BB (Analysis a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int -> BlockMap a -> Maybe (Block (Analysis a)))
-> BlockMap a -> Int -> Maybe (Block (Analysis a))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> BlockMap a -> Maybe (Block (Analysis a))
forall a. Int -> IntMap a -> Maybe a
IM.lookup BlockMap a
bm) ([Int] -> Maybe (BB (Analysis a)))
-> [Int] -> Maybe (BB (Analysis a))
forall a b. (a -> b) -> a -> b
$ ASTBlockNodeSet -> [Int]
IS.toList ASTBlockNodeSet
defSet
            [Maybe String] -> Maybe String
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ((Block (Analysis a) -> Maybe String)
-> BB (Analysis a) -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Block (Analysis a) -> Maybe String
forall a. Data a => String -> Block (Analysis a) -> Maybe String
findSrcName String
v) BB (Analysis a)
bs)

      checkPU ProgramUnit (Analysis a)
_ = CheckArrayReport
forall a. Monoid a => a
mempty
  let reports :: [CheckArrayReport]
reports = (ProgramUnit (Analysis a) -> CheckArrayReport)
-> [ProgramUnit (Analysis a)] -> [CheckArrayReport]
forall a b. (a -> b) -> [a] -> [b]
map ProgramUnit (Analysis a) -> CheckArrayReport
checkPU (ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile (Analysis a)
pf'')

  CheckArrayReport -> PureAnalysis String () CheckArrayReport
forall (m :: * -> *) a. Monad m => a -> m a
return (CheckArrayReport -> PureAnalysis String () CheckArrayReport)
-> CheckArrayReport -> PureAnalysis String () CheckArrayReport
forall a b. NFData a => (a -> b) -> a -> b
$!! [CheckArrayReport] -> CheckArrayReport
forall a. Monoid a => [a] -> a
mconcat [CheckArrayReport]
reports

-- Look through a piece of AST for the source name of a given var name.
findSrcName :: forall a. Data a => F.Name -> F.Block (F.Analysis a) -> Maybe F.Name
findSrcName :: String -> Block (Analysis a) -> Maybe String
findSrcName String
v Block (Analysis a)
b = [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe
  [ Expression (Analysis a) -> String
forall a. Expression (Analysis a) -> String
F.srcName Expression (Analysis a)
e | e :: Expression (Analysis a)
e@(F.ExpValue Analysis a
_ SrcSpan
_ F.ValVariable{}) <- Block (Analysis a) -> [Expression (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi Block (Analysis a)
b :: [F.Expression (F.Analysis a)]
                , Expression (Analysis a) -> String
forall a. Expression (Analysis a) -> String
F.varName Expression (Analysis a)
e String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v ]

instance Describe CheckArrayReport where
  describeBuilder :: CheckArrayReport -> Builder
describeBuilder (CheckArrayReport {[([String], PULoc)]
missingIdx :: [([String], PULoc)]
nestedIdx :: [([String], PULoc)]
missingIdx :: CheckArrayReport -> [([String], PULoc)]
nestedIdx :: CheckArrayReport -> [([String], PULoc)]
..})
    | [([String], PULoc)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([String], PULoc)]
nestedIdx Bool -> Bool -> Bool
&& [([String], PULoc)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([String], PULoc)]
missingIdx = Builder
"no cases detected"
    | Bool
otherwise = Text -> Builder
Builder.fromText (Text -> Builder) -> ([Text] -> Text) -> [Text] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
unlines ([Text] -> Builder) -> [Text] -> Builder
forall a b. (a -> b) -> a -> b
$
      [ Origin -> Text
forall a. Describe a => a -> Text
describe Origin
orig Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" possibly less efficient order of subscript indices: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
forall a. Describe a => a -> Text
describe [String]
ivars)
      | ([String]
ivars, (ProgramUnitName
_, Origin
orig)) <- [([String], PULoc)]
nestedIdx ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
      [ Origin -> Text
forall a. Describe a => a -> Text
describe Origin
orig Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" possibly missing use of variable(s) in array subscript: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
forall a. Describe a => a -> Text
describe [String]
ivars)
      | ([String]
ivars, (ProgramUnitName
_, Origin
orig)) <- [([String], PULoc)]
missingIdx ]

instance ExitCodeOfReport CheckArrayReport where
  exitCodeOf :: CheckArrayReport -> Int
exitCodeOf (CheckArrayReport {[([String], PULoc)]
missingIdx :: [([String], PULoc)]
nestedIdx :: [([String], PULoc)]
missingIdx :: CheckArrayReport -> [([String], PULoc)]
nestedIdx :: CheckArrayReport -> [([String], PULoc)]
..})
    | [([String], PULoc)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([String], PULoc)]
nestedIdx = Int
0
    | Bool
otherwise = Int
1