{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImplicitParams #-}
module Camfort.Specification.Stencils.CheckFrontend
(
stencilChecking
, CheckResult
, checkFailure
, checkWarnings
, existingStencils
) where
import Prelude hiding (span)
import Control.DeepSeq
import Control.Monad.Reader (ReaderT, asks, runReaderT)
import Control.Monad.State.Strict hiding (state)
import Control.Monad.Writer.Lazy hiding (Product)
import Data.Function (on)
import Data.Generics.Uniplate.Operations
import Data.List (intercalate, sort, union)
import Data.Maybe
import Camfort.Analysis
import Camfort.Analysis.Annotations
import Camfort.Analysis.CommentAnnotator
import Camfort.Specification.Parser (SpecParseError)
import Camfort.Specification.Stencils.Analysis (StencilsAnalysis)
import Camfort.Specification.Stencils.Annotation (SA)
import qualified Camfort.Specification.Stencils.Annotation as SA
import Camfort.Specification.Stencils.CheckBackend
import Camfort.Specification.Stencils.Generate
import Camfort.Specification.Stencils.Model
import qualified Camfort.Specification.Stencils.Parser as Parser
import Camfort.Specification.Stencils.Parser.Types (reqRegions)
import Camfort.Specification.Stencils.Syntax
import qualified Language.Fortran.AST as F
import qualified Language.Fortran.Analysis as FA
import qualified Language.Fortran.Analysis.BBlocks as FAB
import qualified Language.Fortran.Analysis.DataFlow as FAD
import qualified Language.Fortran.Util.Position as FU
newtype CheckResult = CheckResult [StencilResult]
instance NFData CheckResult where
rnf :: CheckResult -> ()
rnf CheckResult
_ = ()
instance ExitCodeOfReport CheckResult where
exitCodeOf :: CheckResult -> Int
exitCodeOf (CheckResult [StencilResult]
rs) = [StencilResult] -> Int
forall a. ExitCodeOfReport a => [a] -> Int
exitCodeOfSet [StencilResult]
rs
getCheckResult :: CheckResult -> [StencilResult]
getCheckResult :: CheckResult -> [StencilResult]
getCheckResult (CheckResult [StencilResult]
rs) = [StencilResult] -> [StencilResult]
forall a. Ord a => [a] -> [a]
sort [StencilResult]
rs
instance Eq CheckResult where
== :: CheckResult -> CheckResult -> Bool
(==) = [StencilResult] -> [StencilResult] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([StencilResult] -> [StencilResult] -> Bool)
-> (CheckResult -> [StencilResult])
-> CheckResult
-> CheckResult
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` CheckResult -> [StencilResult]
getCheckResult
newtype CheckError = CheckError { CheckError -> [StencilCheckError]
getCheckError :: [StencilCheckError] }
newtype CheckWarning = CheckWarning { CheckWarning -> [StencilCheckWarning]
getCheckWarning :: [StencilCheckWarning] }
checkFailure :: CheckResult -> Maybe CheckError
checkFailure :: CheckResult -> Maybe CheckError
checkFailure CheckResult
c = case [Maybe StencilCheckError] -> [StencilCheckError]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe StencilCheckError] -> [StencilCheckError])
-> [Maybe StencilCheckError] -> [StencilCheckError]
forall a b. (a -> b) -> a -> b
$ (StencilResult -> Maybe StencilCheckError)
-> [StencilResult] -> [Maybe StencilCheckError]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StencilResult -> Maybe StencilCheckError
toFailure (CheckResult -> [StencilResult]
getCheckResult CheckResult
c) of
[] -> Maybe CheckError
forall a. Maybe a
Nothing
[StencilCheckError]
xs -> CheckError -> Maybe CheckError
forall a. a -> Maybe a
Just (CheckError -> Maybe CheckError) -> CheckError -> Maybe CheckError
forall a b. (a -> b) -> a -> b
$ [StencilCheckError] -> CheckError
CheckError [StencilCheckError]
xs
where toFailure :: StencilResult -> Maybe StencilCheckError
toFailure (SCFail StencilCheckError
err) = StencilCheckError -> Maybe StencilCheckError
forall a. a -> Maybe a
Just StencilCheckError
err
toFailure StencilResult
_ = Maybe StencilCheckError
forall a. Maybe a
Nothing
checkWarnings :: CheckResult -> Maybe CheckWarning
checkWarnings :: CheckResult -> Maybe CheckWarning
checkWarnings CheckResult
c = case [Maybe StencilCheckWarning] -> [StencilCheckWarning]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe StencilCheckWarning] -> [StencilCheckWarning])
-> [Maybe StencilCheckWarning] -> [StencilCheckWarning]
forall a b. (a -> b) -> a -> b
$ (StencilResult -> Maybe StencilCheckWarning)
-> [StencilResult] -> [Maybe StencilCheckWarning]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StencilResult -> Maybe StencilCheckWarning
toWarning (CheckResult -> [StencilResult]
getCheckResult CheckResult
c) of
[] -> Maybe CheckWarning
forall a. Maybe a
Nothing
[StencilCheckWarning]
xs -> CheckWarning -> Maybe CheckWarning
forall a. a -> Maybe a
Just (CheckWarning -> Maybe CheckWarning)
-> CheckWarning -> Maybe CheckWarning
forall a b. (a -> b) -> a -> b
$ [StencilCheckWarning] -> CheckWarning
CheckWarning [StencilCheckWarning]
xs
where toWarning :: StencilResult -> Maybe StencilCheckWarning
toWarning (SCWarn StencilCheckWarning
warn) = StencilCheckWarning -> Maybe StencilCheckWarning
forall a. a -> Maybe a
Just StencilCheckWarning
warn
toWarning StencilResult
_ = Maybe StencilCheckWarning
forall a. Maybe a
Nothing
data StencilResult
= SCOkay { StencilResult -> SrcSpan
scSpan :: FU.SrcSpan
, StencilResult -> Specification
scSpec :: Specification
, StencilResult -> Variable
scVar :: Variable
, StencilResult -> SrcSpan
scBodySpan :: FU.SrcSpan
}
| SCFail StencilCheckError
| SCWarn StencilCheckWarning
deriving (StencilResult -> StencilResult -> Bool
(StencilResult -> StencilResult -> Bool)
-> (StencilResult -> StencilResult -> Bool) -> Eq StencilResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StencilResult -> StencilResult -> Bool
== :: StencilResult -> StencilResult -> Bool
$c/= :: StencilResult -> StencilResult -> Bool
/= :: StencilResult -> StencilResult -> Bool
Eq)
instance ExitCodeOfReport StencilResult where
exitCodeOf :: StencilResult -> Int
exitCodeOf (SCOkay {}) = Int
0
exitCodeOf (SCFail StencilCheckError
_) = Int
1
exitCodeOf (SCWarn StencilCheckWarning
_) = Int
0
class GetSpan a where
getSpan :: a -> FU.SrcSpan
instance GetSpan StencilResult where
getSpan :: StencilResult -> SrcSpan
getSpan SCOkay{scSpan :: StencilResult -> SrcSpan
scSpan = SrcSpan
srcSpan} = SrcSpan
srcSpan
getSpan (SCFail StencilCheckError
err) = StencilCheckError -> SrcSpan
forall a. GetSpan a => a -> SrcSpan
getSpan StencilCheckError
err
getSpan (SCWarn StencilCheckWarning
warn) = StencilCheckWarning -> SrcSpan
forall a. GetSpan a => a -> SrcSpan
getSpan StencilCheckWarning
warn
instance GetSpan StencilCheckError where
getSpan :: StencilCheckError -> SrcSpan
getSpan (SynToAstError SynToAstError
_ SrcSpan
srcSpan) = SrcSpan
srcSpan
getSpan (NotWellSpecified (SrcSpan
srcSpan, SpecDecls
_) (SrcSpan, SpecDecls)
_) = SrcSpan
srcSpan
getSpan (ParseError SrcSpan
srcSpan SpecParseError SpecParseError
_) = SrcSpan
srcSpan
getSpan (RegionExists SrcSpan
srcSpan Variable
_) = SrcSpan
srcSpan
instance GetSpan StencilCheckWarning where
getSpan :: StencilCheckWarning -> SrcSpan
getSpan (DuplicateSpecification SrcSpan
srcSpan) = SrcSpan
srcSpan
getSpan (UnusedRegion SrcSpan
srcSpan Variable
_) = SrcSpan
srcSpan
instance Ord StencilResult where
compare :: StencilResult -> StencilResult -> Ordering
compare = SrcSpan -> SrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SrcSpan -> SrcSpan -> Ordering)
-> (StencilResult -> SrcSpan)
-> StencilResult
-> StencilResult
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` StencilResult -> SrcSpan
forall a. GetSpan a => a -> SrcSpan
getSpan
instance Ord StencilCheckError where
compare :: StencilCheckError -> StencilCheckError -> Ordering
compare = SrcSpan -> SrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SrcSpan -> SrcSpan -> Ordering)
-> (StencilCheckError -> SrcSpan)
-> StencilCheckError
-> StencilCheckError
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` StencilCheckError -> SrcSpan
forall a. GetSpan a => a -> SrcSpan
getSpan
data StencilCheckError
= SynToAstError SynToAstError FU.SrcSpan
| NotWellSpecified (FU.SrcSpan, SpecDecls) (FU.SrcSpan, SpecDecls)
| ParseError FU.SrcSpan (SpecParseError Parser.SpecParseError)
| RegionExists FU.SrcSpan Variable
deriving (StencilCheckError -> StencilCheckError -> Bool
(StencilCheckError -> StencilCheckError -> Bool)
-> (StencilCheckError -> StencilCheckError -> Bool)
-> Eq StencilCheckError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StencilCheckError -> StencilCheckError -> Bool
== :: StencilCheckError -> StencilCheckError -> Bool
$c/= :: StencilCheckError -> StencilCheckError -> Bool
/= :: StencilCheckError -> StencilCheckError -> Bool
Eq)
synToAstError :: SynToAstError -> FU.SrcSpan -> StencilResult
synToAstError :: SynToAstError -> SrcSpan -> StencilResult
synToAstError SynToAstError
err SrcSpan
srcSpan = StencilCheckError -> StencilResult
SCFail (StencilCheckError -> StencilResult)
-> StencilCheckError -> StencilResult
forall a b. (a -> b) -> a -> b
$ SynToAstError -> SrcSpan -> StencilCheckError
SynToAstError SynToAstError
err SrcSpan
srcSpan
notWellSpecified :: (FU.SrcSpan, SpecDecls) -> (FU.SrcSpan, SpecDecls) -> StencilResult
notWellSpecified :: (SrcSpan, SpecDecls) -> (SrcSpan, SpecDecls) -> StencilResult
notWellSpecified (SrcSpan, SpecDecls)
got (SrcSpan, SpecDecls)
inferred = StencilCheckError -> StencilResult
SCFail (StencilCheckError -> StencilResult)
-> StencilCheckError -> StencilResult
forall a b. (a -> b) -> a -> b
$ (SrcSpan, SpecDecls) -> (SrcSpan, SpecDecls) -> StencilCheckError
NotWellSpecified (SrcSpan, SpecDecls)
got (SrcSpan, SpecDecls)
inferred
parseError :: FU.SrcSpan -> SpecParseError Parser.SpecParseError -> StencilResult
parseError :: SrcSpan -> SpecParseError SpecParseError -> StencilResult
parseError SrcSpan
srcSpan SpecParseError SpecParseError
err = StencilCheckError -> StencilResult
SCFail (StencilCheckError -> StencilResult)
-> StencilCheckError -> StencilResult
forall a b. (a -> b) -> a -> b
$ SrcSpan -> SpecParseError SpecParseError -> StencilCheckError
ParseError SrcSpan
srcSpan SpecParseError SpecParseError
err
regionExistsError :: FU.SrcSpan -> Variable -> StencilResult
regionExistsError :: SrcSpan -> Variable -> StencilResult
regionExistsError SrcSpan
srcSpan Variable
r = StencilCheckError -> StencilResult
SCFail (StencilCheckError -> StencilResult)
-> StencilCheckError -> StencilResult
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Variable -> StencilCheckError
RegionExists SrcSpan
srcSpan Variable
r
data StencilCheckWarning
= DuplicateSpecification FU.SrcSpan
| UnusedRegion FU.SrcSpan Variable
deriving (StencilCheckWarning -> StencilCheckWarning -> Bool
(StencilCheckWarning -> StencilCheckWarning -> Bool)
-> (StencilCheckWarning -> StencilCheckWarning -> Bool)
-> Eq StencilCheckWarning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StencilCheckWarning -> StencilCheckWarning -> Bool
== :: StencilCheckWarning -> StencilCheckWarning -> Bool
$c/= :: StencilCheckWarning -> StencilCheckWarning -> Bool
/= :: StencilCheckWarning -> StencilCheckWarning -> Bool
Eq)
duplicateSpecification :: FU.SrcSpan -> StencilResult
duplicateSpecification :: SrcSpan -> StencilResult
duplicateSpecification = StencilCheckWarning -> StencilResult
SCWarn (StencilCheckWarning -> StencilResult)
-> (SrcSpan -> StencilCheckWarning) -> SrcSpan -> StencilResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> StencilCheckWarning
DuplicateSpecification
unusedRegion :: FU.SrcSpan -> Variable -> StencilResult
unusedRegion :: SrcSpan -> Variable -> StencilResult
unusedRegion SrcSpan
srcSpan Variable
var = StencilCheckWarning -> StencilResult
SCWarn (StencilCheckWarning -> StencilResult)
-> StencilCheckWarning -> StencilResult
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Variable -> StencilCheckWarning
UnusedRegion SrcSpan
srcSpan Variable
var
specOkay :: FU.SrcSpan -> Specification -> Variable -> FU.SrcSpan -> StencilResult
specOkay :: SrcSpan -> Specification -> Variable -> SrcSpan -> StencilResult
specOkay SrcSpan
spanSpec Specification
spec Variable
var SrcSpan
spanBody =
SCOkay { scSpan :: SrcSpan
scSpan = SrcSpan
spanSpec
, scSpec :: Specification
scSpec = Specification
spec
, scBodySpan :: SrcSpan
scBodySpan = SrcSpan
spanBody
, scVar :: Variable
scVar = Variable
var
}
prettyWithSpan :: FU.SrcSpan -> String -> String
prettyWithSpan :: SrcSpan -> Variable -> Variable
prettyWithSpan SrcSpan
srcSpan Variable
s = SrcSpan -> Variable
forall a. Show a => a -> Variable
show SrcSpan
srcSpan Variable -> Variable -> Variable
forall a. [a] -> [a] -> [a]
++ Variable
" " Variable -> Variable -> Variable
forall a. [a] -> [a] -> [a]
++ Variable
s
instance Show CheckResult where
show :: CheckResult -> Variable
show = Variable -> [Variable] -> Variable
forall a. [a] -> [[a]] -> [a]
intercalate Variable
"\n" ([Variable] -> Variable)
-> (CheckResult -> [Variable]) -> CheckResult -> Variable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StencilResult -> Variable) -> [StencilResult] -> [Variable]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StencilResult -> Variable
forall a. Show a => a -> Variable
show ([StencilResult] -> [Variable])
-> (CheckResult -> [StencilResult]) -> CheckResult -> [Variable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckResult -> [StencilResult]
getCheckResult
instance Describe CheckResult
instance Show CheckError where
show :: CheckError -> Variable
show = Variable -> [Variable] -> Variable
forall a. [a] -> [[a]] -> [a]
intercalate Variable
"\n" ([Variable] -> Variable)
-> (CheckError -> [Variable]) -> CheckError -> Variable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StencilCheckError -> Variable)
-> [StencilCheckError] -> [Variable]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StencilCheckError -> Variable
forall a. Show a => a -> Variable
show ([StencilCheckError] -> [Variable])
-> (CheckError -> [StencilCheckError]) -> CheckError -> [Variable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckError -> [StencilCheckError]
getCheckError
instance Show CheckWarning where
show :: CheckWarning -> Variable
show = Variable -> [Variable] -> Variable
forall a. [a] -> [[a]] -> [a]
intercalate Variable
"\n" ([Variable] -> Variable)
-> (CheckWarning -> [Variable]) -> CheckWarning -> Variable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StencilCheckWarning -> Variable)
-> [StencilCheckWarning] -> [Variable]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StencilCheckWarning -> Variable
forall a. Show a => a -> Variable
show ([StencilCheckWarning] -> [Variable])
-> (CheckWarning -> [StencilCheckWarning])
-> CheckWarning
-> [Variable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckWarning -> [StencilCheckWarning]
getCheckWarning
instance Show StencilResult where
show :: StencilResult -> Variable
show SCOkay{ scSpan :: StencilResult -> SrcSpan
scSpan = SrcSpan
span } = SrcSpan -> Variable -> Variable
prettyWithSpan SrcSpan
span Variable
"Correct."
show (SCFail StencilCheckError
err) = StencilCheckError -> Variable
forall a. Show a => a -> Variable
show StencilCheckError
err
show (SCWarn StencilCheckWarning
warn) = StencilCheckWarning -> Variable
forall a. Show a => a -> Variable
show StencilCheckWarning
warn
instance Show StencilCheckError where
show :: StencilCheckError -> Variable
show (SynToAstError SynToAstError
err SrcSpan
srcSpan) = SrcSpan -> Variable -> Variable
prettyWithSpan SrcSpan
srcSpan (SynToAstError -> Variable
forall a. Show a => a -> Variable
show SynToAstError
err)
show (NotWellSpecified (SrcSpan
spanActual, SpecDecls
stencilActual) (SrcSpan
spanInferred, SpecDecls
stencilInferred)) =
[Variable] -> Variable
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Variable] -> Variable) -> [Variable] -> Variable
forall a b. (a -> b) -> a -> b
$ [SrcSpan -> Variable -> Variable
prettyWithSpan SrcSpan
spanActual Variable
"Not well specified.\n", Variable
sp,
Variable
"Specification is:\n", Variable
sp, Variable
sp, SpecDecls -> Variable
pprintSpecDecls SpecDecls
stencilActual, Variable
"\n",
Variable
sp, Variable
"but at ", SrcSpan -> Variable
forall a. Show a => a -> Variable
show SrcSpan
spanInferred] [Variable] -> [Variable] -> [Variable]
forall a. [a] -> [a] -> [a]
++ [Variable]
msg
where
sp :: Variable
sp = Int -> Char -> Variable
forall a. Int -> a -> [a]
replicate Int
8 Char
' '
msg :: [Variable]
msg = case SpecDecls
stencilInferred of
[] -> [Variable
" there is no specifiable array computation"]
SpecDecls
_ -> [Variable
" the code behaves as\n", Variable
sp, Variable
sp, SpecDecls -> Variable
pprintSpecDecls SpecDecls
stencilInferred]
show (ParseError SrcSpan
srcSpan SpecParseError SpecParseError
err) = SrcSpan -> Variable -> Variable
prettyWithSpan SrcSpan
srcSpan (SpecParseError SpecParseError -> Variable
forall a. Show a => a -> Variable
show SpecParseError SpecParseError
err)
show (RegionExists SrcSpan
srcSpan Variable
name) =
SrcSpan -> Variable -> Variable
prettyWithSpan SrcSpan
srcSpan (Variable
"Region '" Variable -> Variable -> Variable
forall a. [a] -> [a] -> [a]
++ Variable
name Variable -> Variable -> Variable
forall a. [a] -> [a] -> [a]
++ Variable
"' already defined")
instance Show StencilCheckWarning where
show :: StencilCheckWarning -> Variable
show (DuplicateSpecification SrcSpan
srcSpan) = SrcSpan -> Variable -> Variable
prettyWithSpan SrcSpan
srcSpan
Variable
"Warning: Duplicate specification."
show (UnusedRegion SrcSpan
srcSpan Variable
name) = SrcSpan -> Variable -> Variable
prettyWithSpan SrcSpan
srcSpan (Variable -> Variable) -> Variable -> Variable
forall a b. (a -> b) -> a -> b
$
Variable
"Warning: Unused region '" Variable -> Variable -> Variable
forall a. [a] -> [a] -> [a]
++ Variable
name Variable -> Variable -> Variable
forall a. [a] -> [a] -> [a]
++ Variable
"'"
stencilChecking :: F.ProgramFile SA -> StencilsAnalysis CheckResult
stencilChecking :: ProgramFile SA -> StencilsAnalysis CheckResult
stencilChecking ProgramFile SA
pf = do
(((), [StencilResult]) -> CheckResult)
-> AnalysisT () () Identity ((), [StencilResult])
-> StencilsAnalysis CheckResult
forall a b.
(a -> b)
-> AnalysisT () () Identity a -> AnalysisT () () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([StencilResult] -> CheckResult
CheckResult ([StencilResult] -> CheckResult)
-> (((), [StencilResult]) -> [StencilResult])
-> ((), [StencilResult])
-> CheckResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((), [StencilResult]) -> [StencilResult]
forall a b. (a, b) -> b
snd) (AnalysisT () () Identity ((), [StencilResult])
-> StencilsAnalysis CheckResult)
-> (WriterT [StencilResult] StencilsAnalysis ()
-> AnalysisT () () Identity ((), [StencilResult]))
-> WriterT [StencilResult] StencilsAnalysis ()
-> StencilsAnalysis CheckResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [StencilResult] StencilsAnalysis ()
-> AnalysisT () () Identity ((), [StencilResult])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [StencilResult] StencilsAnalysis ()
-> StencilsAnalysis CheckResult)
-> WriterT [StencilResult] StencilsAnalysis ()
-> StencilsAnalysis CheckResult
forall a b. (a -> b) -> a -> b
$ do
ProgramFile SA
pf' <- SpecParser SpecParseError Specification
-> (SrcSpan
-> SpecParseError SpecParseError
-> WriterT [StencilResult] StencilsAnalysis ())
-> ProgramFile SA
-> WriterT [StencilResult] StencilsAnalysis (ProgramFile SA)
forall (m :: * -> *) e a ast.
(Monad m, Data a, Linkable a, ASTEmbeddable a ast) =>
SpecParser e ast
-> (SrcSpan -> SpecParseError e -> m ())
-> ProgramFile a
-> m (ProgramFile a)
annotateComments SpecParser SpecParseError Specification
Parser.specParser (\SrcSpan
srcSpan SpecParseError SpecParseError
err -> [StencilResult] -> WriterT [StencilResult] StencilsAnalysis ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [SrcSpan -> SpecParseError SpecParseError -> StencilResult
parseError SrcSpan
srcSpan SpecParseError SpecParseError
err]) ProgramFile SA
pf
let
bm :: BlockMap (StencilAnnotation A)
bm = ProgramFile SA -> BlockMap (StencilAnnotation A)
forall a. Data a => ProgramFile (Analysis a) -> BlockMap a
FAD.genBlockMap ProgramFile SA
pf'
bbm :: BBlockMap SA
bbm = ProgramFile SA -> BBlockMap SA
forall a.
Data a =>
ProgramFile (Analysis a) -> BBlockMap (Analysis a)
FAB.genBBlockMap ProgramFile SA
pf'
sgr :: SuperBBGr SA
sgr = BBlockMap SA -> SuperBBGr SA
forall a.
Data a =>
BBlockMap (Analysis a) -> SuperBBGr (Analysis a)
FAB.genSuperBBGr BBlockMap SA
bbm
gr :: BBGr SA
gr = SuperBBGr SA -> BBGr SA
forall a. SuperBBGr a -> BBGr a
FAB.superBBGrGraph SuperBBGr SA
sgr
dm :: DefMap
dm = BlockMap (StencilAnnotation A) -> DefMap
forall a. Data a => BlockMap a -> DefMap
FAD.genDefMap BlockMap (StencilAnnotation A)
bm
rd :: InOutMap ASTBlockNodeSet
rd = DefMap -> BBGr SA -> InOutMap ASTBlockNodeSet
forall a.
Data a =>
DefMap -> BBGr (Analysis a) -> InOutMap ASTBlockNodeSet
FAD.reachingDefinitions DefMap
dm BBGr SA
gr
flowsGraph :: CheckerEnv
flowsGraph = BlockMap (StencilAnnotation A)
-> DefMap -> BBGr SA -> InOutMap ASTBlockNodeSet -> CheckerEnv
forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> InOutMap ASTBlockNodeSet
-> FlowsGraph a
FAD.genFlowsToGraph BlockMap (StencilAnnotation A)
bm DefMap
dm BBGr SA
gr InOutMap ASTBlockNodeSet
rd
beMap :: BackEdgeMap
beMap = DomMap -> Gr (BB SA) () -> BackEdgeMap
forall (gr :: * -> * -> *) a b.
Graph gr =>
DomMap -> gr a b -> BackEdgeMap
FAD.genBackEdgeMap (BBGr SA -> DomMap
forall a. BBGr a -> DomMap
FAD.dominators BBGr SA
gr) (Gr (BB SA) () -> BackEdgeMap) -> Gr (BB SA) () -> BackEdgeMap
forall a b. (a -> b) -> a -> b
$ BBGr SA -> Gr (BB SA) ()
forall a. BBGr a -> Gr (BB a) ()
FA.bbgrGr BBGr SA
gr
ivmap :: InductionVarMapByASTBlock
ivmap = BackEdgeMap -> BBGr SA -> InductionVarMapByASTBlock
forall a.
Data a =>
BackEdgeMap -> BBGr (Analysis a) -> InductionVarMapByASTBlock
FAD.genInductionVarMapByASTBlock BackEdgeMap
beMap BBGr SA
gr
results :: ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (ProgramFile SA)
results = (ProgramUnit SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (ProgramUnit SA))
-> ProgramFile SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (ProgramFile SA)
forall from to (m :: * -> *).
(Biplate from to, Applicative m) =>
(to -> m to) -> from -> m from
forall (m :: * -> *).
Applicative m =>
(ProgramUnit SA -> m (ProgramUnit SA))
-> ProgramFile SA -> m (ProgramFile SA)
descendBiM ProgramUnit SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (ProgramUnit SA)
perProgramUnitCheck ProgramFile SA
pf'
let addUnusedRegionsToResult :: ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
addUnusedRegionsToResult = do
[(SrcSpan, Variable)]
regions' <- (CheckState -> [(SrcSpan, Variable)])
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) CheckState
-> ReaderT
CheckerEnv
(StateT CheckState StencilsAnalysis)
[(SrcSpan, Variable)]
forall a b.
(a -> b)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CheckState -> [(SrcSpan, Variable)]
regions ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) CheckState
forall s (m :: * -> *). MonadState s m => m s
get
[Variable]
usedRegions' <- (CheckState -> [Variable])
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) CheckState
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) [Variable]
forall a b.
(a -> b)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CheckState -> [Variable]
usedRegions ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) CheckState
forall s (m :: * -> *). MonadState s m => m s
get
let unused :: [(SrcSpan, Variable)]
unused = ((SrcSpan, Variable) -> Bool)
-> [(SrcSpan, Variable)] -> [(SrcSpan, Variable)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Variable -> [Variable] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Variable]
usedRegions') (Variable -> Bool)
-> ((SrcSpan, Variable) -> Variable) -> (SrcSpan, Variable) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcSpan, Variable) -> Variable
forall a b. (a, b) -> b
snd) [(SrcSpan, Variable)]
regions'
((SrcSpan, Variable)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ())
-> [(SrcSpan, Variable)]
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (StencilResult
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
addResult (StencilResult
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ())
-> ((SrcSpan, Variable) -> StencilResult)
-> (SrcSpan, Variable)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcSpan -> Variable -> StencilResult)
-> (SrcSpan, Variable) -> StencilResult
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SrcSpan -> Variable -> StencilResult
unusedRegion) [(SrcSpan, Variable)]
unused
[StencilResult]
output <- AnalysisT () () Identity [StencilResult]
-> WriterT [StencilResult] StencilsAnalysis [StencilResult]
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [StencilResult] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AnalysisT () () Identity [StencilResult]
-> WriterT [StencilResult] StencilsAnalysis [StencilResult])
-> AnalysisT () () Identity [StencilResult]
-> WriterT [StencilResult] StencilsAnalysis [StencilResult]
forall a b. (a -> b) -> a -> b
$ CheckState -> [StencilResult]
checkResult (CheckState -> [StencilResult])
-> (((), CheckState) -> CheckState)
-> ((), CheckState)
-> [StencilResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((), CheckState) -> CheckState
forall a b. (a, b) -> b
snd (((), CheckState) -> [StencilResult])
-> AnalysisT () () Identity ((), CheckState)
-> AnalysisT () () Identity [StencilResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
-> CheckerEnv
-> CheckState
-> AnalysisT () () Identity ((), CheckState)
forall a.
Checker a
-> CheckerEnv -> CheckState -> StencilsAnalysis (a, CheckState)
runChecker (ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (ProgramFile SA)
results ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (ProgramFile SA)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall a b.
ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) b
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
addUnusedRegionsToResult) CheckerEnv
flowsGraph (InductionVarMapByASTBlock -> CheckState
startState InductionVarMapByASTBlock
ivmap)
[StencilResult] -> WriterT [StencilResult] StencilsAnalysis ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [StencilResult]
output
data CheckState = CheckState
{ CheckState -> RegionEnv
regionEnv :: RegionEnv
, CheckState -> [StencilResult]
checkResult :: [StencilResult]
, CheckState -> Maybe ProgramUnitName
prog :: Maybe F.ProgramUnitName
, CheckState -> InductionVarMapByASTBlock
ivMap :: FAD.InductionVarMapByASTBlock
, CheckState -> [(SrcSpan, Variable)]
regions :: [(FU.SrcSpan, Variable)]
, CheckState -> [Variable]
usedRegions :: [Variable]
}
addResult :: StencilResult -> Checker ()
addResult :: StencilResult
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
addResult StencilResult
r = (CheckState -> CheckState)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\CheckState
s -> CheckState
s { checkResult :: [StencilResult]
checkResult = StencilResult
r StencilResult -> [StencilResult] -> [StencilResult]
forall a. a -> [a] -> [a]
: CheckState -> [StencilResult]
checkResult CheckState
s })
informRegionsUsed :: [Variable] -> Checker ()
informRegionsUsed :: [Variable]
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
informRegionsUsed [Variable]
rs = (CheckState -> CheckState)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
(\CheckState
s -> CheckState
s { usedRegions :: [Variable]
usedRegions = CheckState -> [Variable]
usedRegions CheckState
s [Variable] -> [Variable] -> [Variable]
forall a. Eq a => [a] -> [a] -> [a]
`union` [Variable]
rs })
addRegionToTracked :: FU.SrcSpan -> Variable -> Checker ()
addRegionToTracked :: SrcSpan
-> Variable
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
addRegionToTracked SrcSpan
srcSpan Variable
r =
(CheckState -> CheckState)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\CheckState
s -> CheckState
s { regions :: [(SrcSpan, Variable)]
regions = (SrcSpan
srcSpan, Variable
r) (SrcSpan, Variable)
-> [(SrcSpan, Variable)] -> [(SrcSpan, Variable)]
forall a. a -> [a] -> [a]
: CheckState -> [(SrcSpan, Variable)]
regions CheckState
s })
regionExists :: Variable -> Checker Bool
regionExists :: Variable -> Checker Bool
regionExists Variable
reg = do
[Variable]
knownNames <- (CheckState -> [Variable])
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) CheckState
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) [Variable]
forall a b.
(a -> b)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((SrcSpan, Variable) -> Variable)
-> [(SrcSpan, Variable)] -> [Variable]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpan, Variable) -> Variable
forall a b. (a, b) -> b
snd ([(SrcSpan, Variable)] -> [Variable])
-> (CheckState -> [(SrcSpan, Variable)])
-> CheckState
-> [Variable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckState -> [(SrcSpan, Variable)]
regions) ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) CheckState
forall s (m :: * -> *). MonadState s m => m s
get
Bool -> Checker Bool
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Checker Bool) -> Bool -> Checker Bool
forall a b. (a -> b) -> a -> b
$ Variable
reg Variable -> [Variable] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Variable]
knownNames
startState :: FAD.InductionVarMapByASTBlock -> CheckState
startState :: InductionVarMapByASTBlock -> CheckState
startState InductionVarMapByASTBlock
ivmap =
CheckState { regionEnv :: RegionEnv
regionEnv = []
, checkResult :: [StencilResult]
checkResult = []
, prog :: Maybe ProgramUnitName
prog = Maybe ProgramUnitName
forall a. Maybe a
Nothing
, ivMap :: InductionVarMapByASTBlock
ivMap = InductionVarMapByASTBlock
ivmap
, regions :: [(SrcSpan, Variable)]
regions = []
, usedRegions :: [Variable]
usedRegions = []
}
type CheckerEnv = FAD.FlowsGraph (SA.StencilAnnotation A)
type Checker = ReaderT CheckerEnv (StateT CheckState StencilsAnalysis)
runChecker
:: Checker a
-> FAD.FlowsGraph (SA.StencilAnnotation A) -> CheckState
-> StencilsAnalysis (a, CheckState)
runChecker :: forall a.
Checker a
-> CheckerEnv -> CheckState -> StencilsAnalysis (a, CheckState)
runChecker Checker a
c CheckerEnv
flows CheckState
state = do
let env :: CheckerEnv
env = CheckerEnv
flows
StateT CheckState StencilsAnalysis a
-> CheckState -> StencilsAnalysis (a, CheckState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Checker a -> CheckerEnv -> StateT CheckState StencilsAnalysis a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Checker a
c CheckerEnv
env) CheckState
state
getFlowsGraph :: Checker (FAD.FlowsGraph (SA.StencilAnnotation A))
getFlowsGraph :: Checker CheckerEnv
getFlowsGraph = (CheckerEnv -> CheckerEnv) -> Checker CheckerEnv
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CheckerEnv -> CheckerEnv
forall a. a -> a
id
parseCommentToAST :: SA -> FU.SrcSpan -> Checker (Either SynToAstError SA)
SA
ann SrcSpan
span =
case SA -> Maybe Specification
SA.getParseSpec SA
ann of
Just Specification
stencilComment -> do
[Variable]
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
informRegionsUsed (Specification -> [Variable]
reqRegions Specification
stencilComment)
RegionEnv
renv <- (CheckState -> RegionEnv)
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) CheckState
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) RegionEnv
forall a b.
(a -> b)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CheckState -> RegionEnv
regionEnv ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) CheckState
forall s (m :: * -> *). MonadState s m => m s
get
let ?renv = ?renv::RegionEnv
RegionEnv
renv
case Specification
-> Either
SynToAstError
(Either (Variable, RegionSum) ([Variable], Specification))
forall s t.
(SynToAst s t, ?renv::RegionEnv) =>
s -> Either SynToAstError t
synToAst Specification
stencilComment of
Right Either (Variable, RegionSum) ([Variable], Specification)
ast -> do
SA -> SA
pfun <- ((Variable, RegionSum)
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (SA -> SA))
-> (([Variable], Specification)
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (SA -> SA))
-> Either (Variable, RegionSum) ([Variable], Specification)
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (SA -> SA)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\reg :: (Variable, RegionSum)
reg@(Variable
var,RegionSum
_) -> do
Bool
exists <- Variable -> Checker Bool
regionExists Variable
var
if Bool
exists
then StencilResult
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
addResult (SrcSpan -> Variable -> StencilResult
regionExistsError SrcSpan
span Variable
var)
ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (SA -> SA)
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (SA -> SA)
forall a b.
ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) b
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (SA -> SA)
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (SA -> SA)
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SA -> SA
forall a. a -> a
id
else SrcSpan
-> Variable
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
addRegionToTracked SrcSpan
span Variable
var
ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (SA -> SA)
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (SA -> SA)
forall a b.
ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) b
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (SA -> SA)
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (SA -> SA)
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Variable, RegionSum) -> SA -> SA
SA.giveRegionSpec (Variable, RegionSum)
reg))
((SA -> SA)
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (SA -> SA)
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((SA -> SA)
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (SA -> SA))
-> (([Variable], Specification) -> SA -> SA)
-> ([Variable], Specification)
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (SA -> SA)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpecDecls -> SA -> SA
SA.giveAstSpec (SpecDecls -> SA -> SA)
-> (([Variable], Specification) -> SpecDecls)
-> ([Variable], Specification)
-> SA
-> SA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Variable], Specification) -> SpecDecls
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) Either (Variable, RegionSum) ([Variable], Specification)
ast
Either SynToAstError SA -> Checker (Either SynToAstError SA)
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SynToAstError SA -> Checker (Either SynToAstError SA))
-> (SA -> Either SynToAstError SA)
-> SA
-> Checker (Either SynToAstError SA)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SA -> Either SynToAstError SA
forall a. a -> Either SynToAstError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SA -> Checker (Either SynToAstError SA))
-> SA -> Checker (Either SynToAstError SA)
forall a b. (a -> b) -> a -> b
$ SA -> SA
pfun SA
ann
Left SynToAstError
err -> Either SynToAstError SA -> Checker (Either SynToAstError SA)
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SynToAstError SA -> Checker (Either SynToAstError SA))
-> (SynToAstError -> Either SynToAstError SA)
-> SynToAstError
-> Checker (Either SynToAstError SA)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynToAstError -> Either SynToAstError SA
forall a b. a -> Either a b
Left (SynToAstError -> Checker (Either SynToAstError SA))
-> SynToAstError -> Checker (Either SynToAstError SA)
forall a b. (a -> b) -> a -> b
$ SynToAstError
err
Maybe Specification
_ -> Either SynToAstError SA -> Checker (Either SynToAstError SA)
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SynToAstError SA -> Checker (Either SynToAstError SA))
-> (SA -> Either SynToAstError SA)
-> SA
-> Checker (Either SynToAstError SA)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SA -> Either SynToAstError SA
forall a. a -> Either SynToAstError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SA -> Checker (Either SynToAstError SA))
-> SA -> Checker (Either SynToAstError SA)
forall a b. (a -> b) -> a -> b
$ SA
ann
updateRegionEnv :: SA -> Checker ()
updateRegionEnv :: SA -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
updateRegionEnv SA
ann =
case SA -> Maybe (Variable, RegionSum)
SA.getRegionSpec SA
ann of
Just (Variable, RegionSum)
renv -> (CheckState -> CheckState)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\CheckState
s -> CheckState
s { regionEnv :: RegionEnv
regionEnv = (Variable, RegionSum)
renv (Variable, RegionSum) -> RegionEnv -> RegionEnv
forall a. a -> [a] -> [a]
: CheckState -> RegionEnv
regionEnv CheckState
s })
Maybe (Variable, RegionSum)
_ -> () -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
perProgramUnitCheck ::
F.ProgramUnit SA -> Checker (F.ProgramUnit SA)
perProgramUnitCheck :: ProgramUnit SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (ProgramUnit SA)
perProgramUnitCheck p :: ProgramUnit SA
p@F.PUModule{} = do
(CheckState -> CheckState)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\CheckState
s -> CheckState
s { prog :: Maybe ProgramUnitName
prog = ProgramUnitName -> Maybe ProgramUnitName
forall a. a -> Maybe a
Just (ProgramUnitName -> Maybe ProgramUnitName)
-> ProgramUnitName -> Maybe ProgramUnitName
forall a b. (a -> b) -> a -> b
$ ProgramUnit SA -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
FA.puName ProgramUnit SA
p })
(Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA))
-> ProgramUnit SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (ProgramUnit SA)
forall from to (m :: * -> *).
(Biplate from to, Applicative m) =>
(to -> m to) -> from -> m from
forall (m :: * -> *).
Applicative m =>
(Block SA -> m (Block SA)) -> ProgramUnit SA -> m (ProgramUnit SA)
descendBiM Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
perBlockCheck ProgramUnit SA
p
perProgramUnitCheck ProgramUnit SA
p = (Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA))
-> ProgramUnit SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (ProgramUnit SA)
forall from to (m :: * -> *).
(Biplate from to, Applicative m) =>
(to -> m to) -> from -> m from
forall (m :: * -> *).
Applicative m =>
(Block SA -> m (Block SA)) -> ProgramUnit SA -> m (ProgramUnit SA)
descendBiM Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
perBlockCheck ProgramUnit SA
p
perBlockCheck :: F.Block SA -> Checker (F.Block SA)
perBlockCheck :: Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
perBlockCheck b :: Block SA
b@(F.BlComment SA
ann SrcSpan
span Comment SA
_) = do
Either SynToAstError SA
ast <- SA -> SrcSpan -> Checker (Either SynToAstError SA)
parseCommentToAST SA
ann SrcSpan
span
case Either SynToAstError SA
ast of
Left SynToAstError
err -> StencilResult
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
addResult (SynToAstError -> SrcSpan -> StencilResult
synToAstError SynToAstError
err SrcSpan
span) ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
forall a b.
ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) b
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block SA
b
Right SA
ann' -> do
SA -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
updateRegionEnv SA
ann'
let b' :: Block SA
b' = SA -> Block SA -> Block SA
forall a. a -> Block a -> Block a
forall (f :: * -> *) a. Annotated f => a -> f a -> f a
F.setAnnotation SA
ann' Block SA
b
case (SA -> Maybe SpecDecls
SA.getAstSpec SA
ann', SA -> Maybe (Block SA)
SA.getStencilBlock SA
ann') of
(Just SpecDecls
specDecls, Just Block SA
block) ->
case Block SA
block of
s :: Block SA
s@(F.BlStatement SA
_ SrcSpan
span' Maybe (Expression SA)
_ (F.StExpressionAssign SA
_ SrcSpan
_ Expression SA
lhs Expression SA
_)) -> do
Block SA
-> SpecDecls
-> SrcSpan
-> Maybe [Index SA]
-> SrcSpan
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
checkStencil Block SA
s SpecDecls
specDecls SrcSpan
span' (Expression SA -> Maybe [Index SA]
forall a. Expression (Analysis a) -> Maybe [Index (Analysis a)]
isArraySubscript Expression SA
lhs) SrcSpan
span
Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (m :: * -> *) a. Monad m => a -> m a
return Block SA
b'
F.BlDo{} -> Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (m :: * -> *) a. Monad m => a -> m a
return Block SA
b'
Block SA
_ -> Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (m :: * -> *) a. Monad m => a -> m a
return Block SA
b'
(Maybe SpecDecls, Maybe (Block SA))
_ -> Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (m :: * -> *) a. Monad m => a -> m a
return Block SA
b'
perBlockCheck b :: Block SA
b@(F.BlDo SA
_ SrcSpan
_ Maybe (Expression SA)
_ Maybe Variable
_ Maybe (Expression SA)
_ Maybe (DoSpecification SA)
_ BB SA
body Maybe (Expression SA)
_) = do
(Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA))
-> BB SA
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA))
-> Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
forall from to (m :: * -> *).
(Biplate from to, Applicative m) =>
(to -> m to) -> from -> m from
forall (m :: * -> *).
Applicative m =>
(Block SA -> m (Block SA)) -> Block SA -> m (Block SA)
descendBiM Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
perBlockCheck) BB SA
body
Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (m :: * -> *) a. Monad m => a -> m a
return Block SA
b
perBlockCheck Block SA
b = do
SA -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
updateRegionEnv (SA -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ())
-> (Block SA -> SA)
-> Block SA
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block SA -> SA
forall a. Block a -> a
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation (Block SA
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ())
-> Block SA
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall a b. (a -> b) -> a -> b
$ Block SA
b
(Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA))
-> BB SA
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA))
-> Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
forall from to (m :: * -> *).
(Biplate from to, Applicative m) =>
(to -> m to) -> from -> m from
forall (m :: * -> *).
Applicative m =>
(Block SA -> m (Block SA)) -> Block SA -> m (Block SA)
descendBiM Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
perBlockCheck) (BB SA
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ())
-> BB SA
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall a b. (a -> b) -> a -> b
$ Block SA -> BB SA
forall on. Uniplate on => on -> [on]
children Block SA
b
Block SA
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) (Block SA)
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (m :: * -> *) a. Monad m => a -> m a
return Block SA
b
checkStencil :: F.Block SA -> SpecDecls
-> FU.SrcSpan -> Maybe [F.Index SA] -> FU.SrcSpan -> Checker ()
checkStencil :: Block SA
-> SpecDecls
-> SrcSpan
-> Maybe [Index SA]
-> SrcSpan
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
checkStencil Block SA
block SpecDecls
specDecls SrcSpan
spanInferred Maybe [Index SA]
maybeSubs SrcSpan
span = do
let ([Index SA]
subs, Bool
isStencil) = case Maybe [Index SA]
maybeSubs of
Maybe [Index SA]
Nothing -> ([], Bool
False)
Just [Index SA]
subs' -> ([Index SA]
subs', Bool
True)
InductionVarMapByASTBlock
ivmap <- (CheckState -> InductionVarMapByASTBlock)
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) CheckState
-> ReaderT
CheckerEnv
(StateT CheckState StencilsAnalysis)
InductionVarMapByASTBlock
forall a b.
(a -> b)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CheckState -> InductionVarMapByASTBlock
ivMap ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) CheckState
forall s (m :: * -> *). MonadState s m => m s
get
let ivs :: [Variable]
ivs = InductionVarMapByASTBlock -> Block SA -> [Variable]
forall (ast :: * -> *) a.
(Spanned (ast (Analysis a)), Annotated ast) =>
InductionVarMapByASTBlock -> ast (Analysis a) -> [Variable]
extractRelevantIVS InductionVarMapByASTBlock
ivmap Block SA
block
CheckerEnv
flowsGraph <- Checker CheckerEnv
getFlowsGraph
let lhsN :: [Neighbour]
lhsN = [Neighbour] -> Maybe [Neighbour] -> [Neighbour]
forall a. a -> Maybe a -> a
fromMaybe [] (InductionVarMapByASTBlock -> [Index SA] -> Maybe [Neighbour]
forall a.
Data a =>
InductionVarMapByASTBlock
-> [Index (Analysis a)] -> Maybe [Neighbour]
neighbourIndex InductionVarMapByASTBlock
ivmap [Index SA]
subs)
[(Variable, (Bool, [[Int]]))]
relOffsets <- StateT CheckState StencilsAnalysis [(Variable, (Bool, [[Int]]))]
-> ReaderT
CheckerEnv
(StateT CheckState StencilsAnalysis)
[(Variable, (Bool, [[Int]]))]
forall (m :: * -> *) a. Monad m => m a -> ReaderT CheckerEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT CheckState StencilsAnalysis [(Variable, (Bool, [[Int]]))]
-> ReaderT
CheckerEnv
(StateT CheckState StencilsAnalysis)
[(Variable, (Bool, [[Int]]))])
-> (StencilsAnalysis [(Variable, (Bool, [[Int]]))]
-> StateT
CheckState StencilsAnalysis [(Variable, (Bool, [[Int]]))])
-> StencilsAnalysis [(Variable, (Bool, [[Int]]))]
-> ReaderT
CheckerEnv
(StateT CheckState StencilsAnalysis)
[(Variable, (Bool, [[Int]]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StencilsAnalysis [(Variable, (Bool, [[Int]]))]
-> StateT CheckState StencilsAnalysis [(Variable, (Bool, [[Int]]))]
forall (m :: * -> *) a. Monad m => m a -> StateT CheckState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StencilsAnalysis [(Variable, (Bool, [[Int]]))]
-> ReaderT
CheckerEnv
(StateT CheckState StencilsAnalysis)
[(Variable, (Bool, [[Int]]))])
-> StencilsAnalysis [(Variable, (Bool, [[Int]]))]
-> ReaderT
CheckerEnv
(StateT CheckState StencilsAnalysis)
[(Variable, (Bool, [[Int]]))]
forall a b. (a -> b) -> a -> b
$ ([(Variable, (Bool, [[Int]]))], EvalLog)
-> [(Variable, (Bool, [[Int]]))]
forall a b. (a, b) -> a
fst (([(Variable, (Bool, [[Int]]))], EvalLog)
-> [(Variable, (Bool, [[Int]]))])
-> AnalysisT
() () Identity ([(Variable, (Bool, [[Int]]))], EvalLog)
-> StencilsAnalysis [(Variable, (Bool, [[Int]]))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StencilInferer (StencilAnnotation A) [(Variable, (Bool, [[Int]]))]
-> [Variable]
-> CheckerEnv
-> AnalysisT
() () Identity ([(Variable, (Bool, [[Int]]))], EvalLog)
forall ann a.
StencilInferer ann a
-> [Variable] -> FlowsGraph ann -> StencilsAnalysis (a, EvalLog)
runStencilInferer ([Neighbour]
-> BB SA
-> StencilInferer
(StencilAnnotation A) [(Variable, (Bool, [[Int]]))]
forall a.
(Data a, Show a, Eq a) =>
[Neighbour]
-> [Block (Analysis a)]
-> StencilInferer a [(Variable, (Bool, [[Int]]))]
genOffsets [Neighbour]
lhsN [Block SA
block]) [Variable]
ivs CheckerEnv
flowsGraph
let multOffsets :: [(Variable, Multiplicity [[Int]])]
multOffsets = ((Variable, (Bool, [[Int]])) -> (Variable, Multiplicity [[Int]]))
-> [(Variable, (Bool, [[Int]]))]
-> [(Variable, Multiplicity [[Int]])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Variable, (Bool, [[Int]]))
relOffset ->
case (Variable, (Bool, [[Int]]))
relOffset of
(Variable
var, (Bool
True, [[Int]]
offsets)) -> (Variable
var, [[Int]] -> Multiplicity [[Int]]
forall a. a -> Multiplicity a
Mult [[Int]]
offsets)
(Variable
var, (Bool
False, [[Int]]
offsets)) -> (Variable
var, [[Int]] -> Multiplicity [[Int]]
forall a. a -> Multiplicity a
Once [[Int]]
offsets)) [(Variable, (Bool, [[Int]]))]
relOffsets
expandedDecls :: [(Variable, Specification)]
expandedDecls =
(([Variable], Specification) -> [(Variable, Specification)])
-> SpecDecls -> [(Variable, Specification)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([Variable]
vars,Specification
spec) -> (Variable -> (Variable, Specification))
-> [Variable] -> [(Variable, Specification)]
forall a b. (a -> b) -> [a] -> [b]
map ((Variable -> Specification -> (Variable, Specification))
-> Specification -> Variable -> (Variable, Specification)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Specification
spec) [Variable]
vars) SpecDecls
specDecls
let userDefinedIsStencils :: [Bool]
userDefinedIsStencils = (([Variable], Specification) -> Bool) -> SpecDecls -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (\([Variable]
_, Specification Multiplicity (Approximation Spatial)
_ Bool
b) -> Bool
b) SpecDecls
specDecls
if (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool
isStencil Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==) [Bool]
userDefinedIsStencils Bool -> Bool -> Bool
&& [(Variable, Multiplicity [[Int]])]
-> [(Variable, Specification)] -> Bool
checkOffsetsAgainstSpec [(Variable, Multiplicity [[Int]])]
multOffsets [(Variable, Specification)]
expandedDecls
then ((Variable, Specification)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ())
-> [(Variable, Specification)]
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\spec :: (Variable, Specification)
spec@(Variable
v,Specification
s) -> do
Bool
specExists <- (Variable, Specification) -> Checker Bool
seenBefore (Variable, Specification)
spec
if Bool
specExists then StencilResult
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
addResult (SrcSpan -> StencilResult
duplicateSpecification SrcSpan
span)
else StencilResult
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
addResult (SrcSpan -> Specification -> Variable -> SrcSpan -> StencilResult
specOkay SrcSpan
span Specification
s Variable
v SrcSpan
spanInferred)) [(Variable, Specification)]
expandedDecls
else do
SpecDecls
inferred <- StateT CheckState StencilsAnalysis SpecDecls
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) SpecDecls
forall (m :: * -> *) a. Monad m => m a -> ReaderT CheckerEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT CheckState StencilsAnalysis SpecDecls
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) SpecDecls)
-> (StencilsAnalysis SpecDecls
-> StateT CheckState StencilsAnalysis SpecDecls)
-> StencilsAnalysis SpecDecls
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) SpecDecls
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StencilsAnalysis SpecDecls
-> StateT CheckState StencilsAnalysis SpecDecls
forall (m :: * -> *) a. Monad m => m a -> StateT CheckState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StencilsAnalysis SpecDecls
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) SpecDecls)
-> StencilsAnalysis SpecDecls
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) SpecDecls
forall a b. (a -> b) -> a -> b
$ (SpecDecls, [Int]) -> SpecDecls
forall a b. (a, b) -> a
fst ((SpecDecls, [Int]) -> SpecDecls)
-> (((SpecDecls, [Int]), EvalLog) -> (SpecDecls, [Int]))
-> ((SpecDecls, [Int]), EvalLog)
-> SpecDecls
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SpecDecls, [Int]), EvalLog) -> (SpecDecls, [Int])
forall a b. (a, b) -> a
fst (((SpecDecls, [Int]), EvalLog) -> SpecDecls)
-> AnalysisT () () Identity ((SpecDecls, [Int]), EvalLog)
-> StencilsAnalysis SpecDecls
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StencilInferer (StencilAnnotation A) (SpecDecls, [Int])
-> [Variable]
-> CheckerEnv
-> AnalysisT () () Identity ((SpecDecls, [Int]), EvalLog)
forall ann a.
StencilInferer ann a
-> [Variable] -> FlowsGraph ann -> StencilsAnalysis (a, EvalLog)
runStencilInferer ([Neighbour]
-> Block SA
-> StencilInferer (StencilAnnotation A) (SpecDecls, [Int])
forall a.
(Data a, Show a, Eq a) =>
[Neighbour]
-> Block (Analysis a) -> StencilInferer a (SpecDecls, [Int])
genSpecifications [Neighbour]
lhsN Block SA
block) [Variable]
ivs CheckerEnv
flowsGraph
StencilResult
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) ()
addResult ((SrcSpan, SpecDecls) -> (SrcSpan, SpecDecls) -> StencilResult
notWellSpecified (SrcSpan
span, SpecDecls
specDecls) (SrcSpan
spanInferred, SpecDecls
inferred))
where
seenBefore :: (Variable, Specification) -> Checker Bool
seenBefore :: (Variable, Specification) -> Checker Bool
seenBefore (Variable
v,Specification
spec) = do
[StencilResult]
checkLog <- (CheckState -> [StencilResult])
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) CheckState
-> ReaderT
CheckerEnv (StateT CheckState StencilsAnalysis) [StencilResult]
forall a b.
(a -> b)
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
-> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CheckState -> [StencilResult]
checkResult ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) CheckState
forall s (m :: * -> *). MonadState s m => m s
get
Bool -> Checker Bool
forall a.
a -> ReaderT CheckerEnv (StateT CheckState StencilsAnalysis) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Checker Bool) -> Bool -> Checker Bool
forall a b. (a -> b) -> a -> b
$ (StencilResult -> Bool) -> [StencilResult] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\StencilResult
x -> case StencilResult
x of
SCOkay{ scSpec :: StencilResult -> Specification
scSpec=Specification
spec'
, scBodySpan :: StencilResult -> SrcSpan
scBodySpan=SrcSpan
bspan
, scVar :: StencilResult -> Variable
scVar = Variable
var}
-> Specification
spec' Specification -> Specification -> Bool
forall a. Eq a => a -> a -> Bool
== Specification
spec Bool -> Bool -> Bool
&& SrcSpan
bspan SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
spanInferred Bool -> Bool -> Bool
&& Variable
v Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== Variable
var
StencilResult
_ -> Bool
False) [StencilResult]
checkLog
existingStencils :: CheckResult -> [(Specification, FU.SrcSpan, Variable)]
existingStencils :: CheckResult -> [(Specification, SrcSpan, Variable)]
existingStencils = (StencilResult -> Maybe (Specification, SrcSpan, Variable))
-> [StencilResult] -> [(Specification, SrcSpan, Variable)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe StencilResult -> Maybe (Specification, SrcSpan, Variable)
getExistingStencil ([StencilResult] -> [(Specification, SrcSpan, Variable)])
-> (CheckResult -> [StencilResult])
-> CheckResult
-> [(Specification, SrcSpan, Variable)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckResult -> [StencilResult]
getCheckResult
where getExistingStencil :: StencilResult -> Maybe (Specification, SrcSpan, Variable)
getExistingStencil (SCOkay SrcSpan
_ Specification
spec Variable
var SrcSpan
bodySpan) = (Specification, SrcSpan, Variable)
-> Maybe (Specification, SrcSpan, Variable)
forall a. a -> Maybe a
Just (Specification
spec, SrcSpan
bodySpan, Variable
var)
getExistingStencil StencilResult
_ = Maybe (Specification, SrcSpan, Variable)
forall a. Maybe a
Nothing