{-# LANGUAGE ScopedTypeVariables #-}
module Language.Fortran.Analysis.DataFlow
( dominators, iDominators, DomMap, IDomMap
, postOrder, revPostOrder, preOrder, revPreOrder, OrderF
, dataFlowSolver, InOut, InOutMap, InF, OutF
, liveVariableAnalysis, reachingDefinitions
, genUDMap, genDUMap, duMapToUdMap, UDMap, DUMap
, genFlowsToGraph, FlowsGraph
, genVarFlowsToMap, VarFlowsMap
, Constant(..), ParameterVarMap, ConstExpMap, genConstExpMap, analyseConstExps, analyseParameterVars, constantFolding
, genBlockMap, genDefMap, BlockMap, DefMap
, genCallMap, CallMap
, loopNodes, genBackEdgeMap, sccWith, BackEdgeMap
, genLoopNodeMap, LoopNodeMap
, genInductionVarMap, InductionVarMap
, genInductionVarMapByASTBlock, InductionVarMapByASTBlock
, genDerivedInductionMap, DerivedInductionMap, InductionExpr(..)
, showDataFlow, showFlowsDOT
, BBNodeMap, BBNodeSet, ASTBlockNodeMap, ASTBlockNodeSet, ASTExprNodeMap, ASTExprNodeSet
) where
import Prelude hiding (init)
import Data.Generics.Uniplate.Data
import GHC.Generics
import Data.Data
import qualified Control.Monad.State.Lazy as Lazy
import Control.Monad.State.Strict
import Control.DeepSeq
import Control.Arrow ((&&&))
import Text.PrettyPrint.GenericPretty (Out)
import Language.Fortran.Analysis
import Language.Fortran.Analysis.BBlocks (showBlock, ASTBlockNode, ASTExprNode)
import Language.Fortran.AST
import Language.Fortran.AST.Literal.Real
import qualified Data.Map as M
import qualified Data.IntMap.Lazy as IM
import qualified Data.IntMap.Strict as IMS
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.Graph.Inductive hiding (trc, dom, order, inn, out, rc)
import Data.Maybe
import Data.List (foldl', foldl1', (\\), union, intersect)
import Control.Monad.Writer hiding (fix)
type BBNodeMap = IM.IntMap
type BBNodeSet = IS.IntSet
type ASTBlockNodeMap = IM.IntMap
type ASTBlockNodeSet = IS.IntSet
type ASTExprNodeMap = IMS.IntMap
type ASTExprNodeSet = IS.IntSet
type DomMap = BBNodeMap BBNodeSet
dominators :: BBGr a -> DomMap
dominators :: forall a. BBGr a -> DomMap
dominators BBGr a
bbgr = ((BBNodeSet, BBNodeSet) -> BBNodeSet)
-> IntMap (BBNodeSet, BBNodeSet) -> DomMap
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map (BBNodeSet, BBNodeSet) -> BBNodeSet
forall a b. (a, b) -> b
snd (IntMap (BBNodeSet, BBNodeSet) -> DomMap)
-> IntMap (BBNodeSet, BBNodeSet) -> DomMap
forall a b. (a -> b) -> a -> b
$ BBGr a
-> (Int -> (BBNodeSet, BBNodeSet))
-> OrderF a
-> (OutF BBNodeSet -> OutF BBNodeSet)
-> (OutF BBNodeSet -> OutF BBNodeSet)
-> IntMap (BBNodeSet, BBNodeSet)
forall t a.
(NFData t, Ord t) =>
BBGr a
-> (Int -> InOut t)
-> OrderF a
-> (OutF t -> OutF t)
-> (OutF t -> OutF t)
-> InOutMap t
dataFlowSolver BBGr a
bbgr Int -> (BBNodeSet, BBNodeSet)
forall {p}. p -> (BBNodeSet, BBNodeSet)
init OrderF a
forall a. OrderF a
revPostOrder OutF BBNodeSet -> OutF BBNodeSet
inn OutF BBNodeSet -> OutF BBNodeSet
out
where
gr :: Gr (BB a) ()
gr = BBGr a -> Gr (BB a) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr a
bbgr
nodeSet :: BBNodeSet
nodeSet = [Int] -> BBNodeSet
IS.fromList ([Int] -> BBNodeSet) -> [Int] -> BBNodeSet
forall a b. (a -> b) -> a -> b
$ Gr (BB a) () -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Int]
nodes Gr (BB a) ()
gr
init :: p -> (BBNodeSet, BBNodeSet)
init p
_ = (BBNodeSet
nodeSet, BBNodeSet
nodeSet)
inn :: OutF BBNodeSet -> OutF BBNodeSet
inn OutF BBNodeSet
outF Int
n
| preNodes :: [Int]
preNodes@(Int
_:[Int]
_) <- Gr (BB a) () -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
pre Gr (BB a) ()
gr Int
n = (BBNodeSet -> BBNodeSet -> BBNodeSet) -> [BBNodeSet] -> BBNodeSet
forall a. (a -> a -> a) -> [a] -> a
foldl1' BBNodeSet -> BBNodeSet -> BBNodeSet
IS.intersection ([BBNodeSet] -> BBNodeSet)
-> ([Int] -> [BBNodeSet]) -> [Int] -> BBNodeSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutF BBNodeSet -> [Int] -> [BBNodeSet]
forall a b. (a -> b) -> [a] -> [b]
map OutF BBNodeSet
outF ([Int] -> BBNodeSet) -> [Int] -> BBNodeSet
forall a b. (a -> b) -> a -> b
$ [Int]
preNodes
| Bool
otherwise = BBNodeSet
IS.empty
out :: OutF BBNodeSet -> OutF BBNodeSet
out OutF BBNodeSet
inF Int
n = Int -> BBNodeSet -> BBNodeSet
IS.insert Int
n (BBNodeSet -> BBNodeSet) -> BBNodeSet -> BBNodeSet
forall a b. (a -> b) -> a -> b
$ OutF BBNodeSet
inF Int
n
type IDomMap = BBNodeMap BBNode
iDominators :: BBGr a -> IDomMap
iDominators :: forall a. BBGr a -> IDomMap
iDominators BBGr a
gr = [IDomMap] -> IDomMap
forall (f :: * -> *) a. Foldable f => f (IntMap a) -> IntMap a
IM.unions [ [(Int, Int)] -> IDomMap
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, Int)] -> IDomMap)
-> (Gr (BB a) () -> [(Int, Int)]) -> Gr (BB a) () -> IDomMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Gr (BB a) () -> Int -> [(Int, Int)])
-> Int -> Gr (BB a) () -> [(Int, Int)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Gr (BB a) () -> Int -> [(Int, Int)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [(Int, Int)]
iDom Int
n (Gr (BB a) () -> IDomMap) -> Gr (BB a) () -> IDomMap
forall a b. (a -> b) -> a -> b
$ BBGr a -> Gr (BB a) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr a
gr | Int
n <- BBGr a -> [Int]
forall a. OrderF a
bbgrEntries BBGr a
gr ]
type OrderF a = BBGr a -> [Node]
postOrder :: OrderF a
postOrder :: forall a. OrderF a
postOrder BBGr a
gr = (Tree Int -> [Int]) -> [Tree Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree Int -> [Int]
forall a. Tree a -> [a]
postorder ([Tree Int] -> [Int])
-> (Gr (BB a) () -> [Tree Int]) -> Gr (BB a) () -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Gr (BB a) () -> [Tree Int]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> [Tree Int]
dff (BBGr a -> [Int]
forall a. OrderF a
bbgrEntries BBGr a
gr) (Gr (BB a) () -> [Int]) -> Gr (BB a) () -> [Int]
forall a b. (a -> b) -> a -> b
$ BBGr a -> Gr (BB a) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr a
gr
revPostOrder :: OrderF a
revPostOrder :: forall a. OrderF a
revPostOrder = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> (BBGr a -> [Int]) -> BBGr a -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BBGr a -> [Int]
forall a. OrderF a
postOrder
preOrder :: OrderF a
preOrder :: forall a. OrderF a
preOrder BBGr a
gr = (Tree Int -> [Int]) -> [Tree Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree Int -> [Int]
forall a. Tree a -> [a]
preorder ([Tree Int] -> [Int])
-> (Gr (BB a) () -> [Tree Int]) -> Gr (BB a) () -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Gr (BB a) () -> [Tree Int]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> [Tree Int]
dff (BBGr a -> [Int]
forall a. OrderF a
bbgrEntries BBGr a
gr) (Gr (BB a) () -> [Int]) -> Gr (BB a) () -> [Int]
forall a b. (a -> b) -> a -> b
$ BBGr a -> Gr (BB a) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr a
gr
revPreOrder :: OrderF a
revPreOrder :: forall a. OrderF a
revPreOrder = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> (BBGr a -> [Int]) -> BBGr a -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BBGr a -> [Int]
forall a. OrderF a
preOrder
type InOut t = (t, t)
type InOutMap t = BBNodeMap (InOut t)
type InF t = Node -> t
type OutF t = Node -> t
dataFlowSolver :: (NFData t, Ord t)
=> BBGr a
-> (Node -> InOut t)
-> OrderF a
-> (OutF t -> InF t)
-> (InF t -> OutF t)
-> InOutMap t
dataFlowSolver :: forall t a.
(NFData t, Ord t) =>
BBGr a
-> (Int -> InOut t)
-> OrderF a
-> (OutF t -> OutF t)
-> (OutF t -> OutF t)
-> InOutMap t
dataFlowSolver BBGr a
gr Int -> (t, t)
initF OrderF a
order OutF t -> OutF t
inF OutF t -> OutF t
outF = (InOutMap t -> InOutMap t -> Bool) -> [InOutMap t] -> InOutMap t
forall a. (a -> a -> Bool) -> [a] -> a
converge InOutMap t -> InOutMap t -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([InOutMap t] -> InOutMap t) -> [InOutMap t] -> InOutMap t
forall a b. (a -> b) -> a -> b
$ (InOutMap t -> InOutMap t) -> InOutMap t -> [InOutMap t]
forall {t}. NFData t => (t -> t) -> t -> [t]
iterate' InOutMap t -> InOutMap t
step InOutMap t
initM
where
ordNodes :: [Int]
ordNodes = OrderF a
order BBGr a
gr
initM :: InOutMap t
initM = [(Int, (t, t))] -> InOutMap t
forall a. [(Int, a)] -> IntMap a
IM.fromList [ (Int
n, Int -> (t, t)
initF Int
n) | Int
n <- [Int]
ordNodes ]
step :: InOutMap t -> InOutMap t
step !InOutMap t
m = [(Int, (t, t))] -> InOutMap t
forall a. [(Int, a)] -> IntMap a
IM.fromList [ (Int
n, (OutF t -> OutF t
inF ((t, t) -> t
forall a b. (a, b) -> b
snd ((t, t) -> t) -> (Int -> (t, t)) -> OutF t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InOutMap t -> Int -> (t, t)
forall {a}. IntMap a -> Int -> a
get' InOutMap t
m) Int
n, OutF t -> OutF t
outF ((t, t) -> t
forall a b. (a, b) -> a
fst ((t, t) -> t) -> (Int -> (t, t)) -> OutF t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InOutMap t -> Int -> (t, t)
forall {a}. IntMap a -> Int -> a
get' InOutMap t
m) Int
n)) | Int
n <- [Int]
ordNodes ]
get' :: IntMap a -> Int -> a
get' IntMap a
m Int
n = Name -> Maybe a -> a
forall a. Name -> Maybe a -> a
fromJustMsg (Name
"dataFlowSolver: get " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Int -> Name
forall a. Show a => a -> Name
show Int
n) (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ Int -> IntMap a -> Maybe a
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
n IntMap a
m
iterate' :: (t -> t) -> t -> [t]
iterate' t -> t
f t
x = t
x t -> t -> t
forall a b. NFData a => a -> b -> b
`deepseq` t
x t -> [t] -> [t]
forall a. a -> [a] -> [a]
: (t -> t) -> t -> [t]
iterate' t -> t
f (t -> t
f t
x)
type BlockMap a = ASTBlockNodeMap (Block (Analysis a))
genBlockMap :: Data a => ProgramFile (Analysis a) -> BlockMap a
genBlockMap :: forall a. Data a => ProgramFile (Analysis a) -> BlockMap a
genBlockMap ProgramFile (Analysis a)
pf = [(Int, Block (Analysis a))] -> IntMap (Block (Analysis a))
forall a. [(Int, a)] -> IntMap a
IM.fromList [ (Int
i, Block (Analysis a)
b) | BBGr (Analysis a)
gr <- ProgramFile (Analysis a) -> [BBGr (Analysis a)]
forall a. Data a => ProgramFile (Analysis a) -> [BBGr (Analysis a)]
uni ProgramFile (Analysis a)
pf
, (Int
_, BB (Analysis a)
bs) <- Gr (BB (Analysis a)) () -> [(Int, BB (Analysis a))]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes (Gr (BB (Analysis a)) () -> [(Int, BB (Analysis a))])
-> Gr (BB (Analysis a)) () -> [(Int, BB (Analysis a))]
forall a b. (a -> b) -> a -> b
$ BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr
, Block (Analysis a)
b <- BB (Analysis a)
bs
, let Just Int
i = Analysis a -> Maybe Int
forall a. Analysis a -> Maybe Int
insLabel (Block (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Block (Analysis a)
b) ]
where
uni :: Data a => ProgramFile (Analysis a) -> [BBGr (Analysis a)]
uni :: forall a. Data a => ProgramFile (Analysis a) -> [BBGr (Analysis a)]
uni = ProgramFile (Analysis a) -> [BBGr (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi
type DefMap = M.Map Name ASTBlockNodeSet
genDefMap :: Data a => BlockMap a -> DefMap
genDefMap :: forall a. Data a => BlockMap a -> DefMap
genDefMap BlockMap a
bm = (BBNodeSet -> BBNodeSet -> BBNodeSet)
-> [(Name, BBNodeSet)] -> DefMap
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith BBNodeSet -> BBNodeSet -> BBNodeSet
IS.union [
(Name
y, OutF BBNodeSet
IS.singleton Int
i) | (Int
i, Block (Analysis a)
b) <- BlockMap a -> [(Int, Block (Analysis a))]
forall a. IntMap a -> [(Int, a)]
IM.toList BlockMap a
bm, Name
y <- Block (Analysis a) -> [Name]
forall a. Data a => Block (Analysis a) -> [Name]
allLhsVars Block (Analysis a)
b
]
liveVariableAnalysis :: Data a => BBGr (Analysis a) -> InOutMap (S.Set Name)
liveVariableAnalysis :: forall a. Data a => BBGr (Analysis a) -> InOutMap (Set Name)
liveVariableAnalysis BBGr (Analysis a)
gr = BBGr (Analysis a)
-> (Int -> InOut (Set Name))
-> OrderF (Analysis a)
-> (OutF (Set Name) -> OutF (Set Name))
-> (OutF (Set Name) -> OutF (Set Name))
-> InOutMap (Set Name)
forall t a.
(NFData t, Ord t) =>
BBGr a
-> (Int -> InOut t)
-> OrderF a
-> (OutF t -> OutF t)
-> (OutF t -> OutF t)
-> InOutMap t
dataFlowSolver BBGr (Analysis a)
gr (InOut (Set Name) -> Int -> InOut (Set Name)
forall a b. a -> b -> a
const (Set Name
forall a. Set a
S.empty, Set Name
forall a. Set a
S.empty)) OrderF (Analysis a)
forall a. OrderF a
revPreOrder OutF (Set Name) -> OutF (Set Name)
inn OutF (Set Name) -> OutF (Set Name)
forall {a}. Ord a => (Int -> Set a) -> Int -> Set a
out
where
inn :: OutF (Set Name) -> OutF (Set Name)
inn OutF (Set Name)
outF Int
b = (OutF (Set Name)
outF Int
b Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.\\ OutF (Set Name)
kill Int
b) Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
`S.union` OutF (Set Name)
gen Int
b
out :: (Int -> Set a) -> Int -> Set a
out Int -> Set a
innF Int
b = [Set a] -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions [ Int -> Set a
innF Int
s | Int
s <- Gr (BB (Analysis a)) () -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
suc (BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
b ]
kill :: OutF (Set Name)
kill Int
b = BB (Analysis a) -> Set Name
forall a. Data a => [Block (Analysis a)] -> Set Name
bblockKill (Name -> Maybe (BB (Analysis a)) -> BB (Analysis a)
forall a. Name -> Maybe a -> a
fromJustMsg Name
"liveVariableAnalysis kill" (Maybe (BB (Analysis a)) -> BB (Analysis a))
-> Maybe (BB (Analysis a)) -> BB (Analysis a)
forall a b. (a -> b) -> a -> b
$ Gr (BB (Analysis a)) () -> Int -> Maybe (BB (Analysis a))
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
b)
gen :: OutF (Set Name)
gen Int
b = BB (Analysis a) -> Set Name
forall a. Data a => [Block (Analysis a)] -> Set Name
bblockGen (Name -> Maybe (BB (Analysis a)) -> BB (Analysis a)
forall a. Name -> Maybe a -> a
fromJustMsg Name
"liveVariableAnalysis gen" (Maybe (BB (Analysis a)) -> BB (Analysis a))
-> Maybe (BB (Analysis a)) -> BB (Analysis a)
forall a b. (a -> b) -> a -> b
$ Gr (BB (Analysis a)) () -> Int -> Maybe (BB (Analysis a))
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
b)
bblockKill :: Data a => [Block (Analysis a)] -> S.Set Name
bblockKill :: forall a. Data a => [Block (Analysis a)] -> Set Name
bblockKill = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList ([Name] -> Set Name)
-> ([Block (Analysis a)] -> [Name])
-> [Block (Analysis a)]
-> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block (Analysis a) -> [Name]) -> [Block (Analysis a)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block (Analysis a) -> [Name]
forall a. Data a => Block (Analysis a) -> [Name]
blockKill
bblockGen :: Data a => [Block (Analysis a)] -> S.Set Name
bblockGen :: forall a. Data a => [Block (Analysis a)] -> Set Name
bblockGen [Block (Analysis a)]
bs = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList ([Name] -> Set Name)
-> ([([Name], [Name])] -> [Name]) -> [([Name], [Name])] -> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Name], [Name]) -> [Name]
forall a b. (a, b) -> a
fst (([Name], [Name]) -> [Name])
-> ([([Name], [Name])] -> ([Name], [Name]))
-> [([Name], [Name])]
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Name], [Name]) -> ([Name], [Name]) -> ([Name], [Name]))
-> ([Name], [Name]) -> [([Name], [Name])] -> ([Name], [Name])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([Name], [Name]) -> ([Name], [Name]) -> ([Name], [Name])
forall {a}. Eq a => ([a], [a]) -> ([a], [a]) -> ([a], [a])
f ([], []) ([([Name], [Name])] -> Set Name) -> [([Name], [Name])] -> Set Name
forall a b. (a -> b) -> a -> b
$ (Block (Analysis a) -> ([Name], [Name]))
-> [Block (Analysis a)] -> [([Name], [Name])]
forall a b. (a -> b) -> [a] -> [b]
map (Block (Analysis a) -> [Name]
forall a. Data a => Block (Analysis a) -> [Name]
blockGen (Block (Analysis a) -> [Name])
-> (Block (Analysis a) -> [Name])
-> Block (Analysis a)
-> ([Name], [Name])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Block (Analysis a) -> [Name]
forall a. Data a => Block (Analysis a) -> [Name]
blockKill) [Block (Analysis a)]
bs
where
f :: ([a], [a]) -> ([a], [a]) -> ([a], [a])
f ([a]
bbgen, [a]
bbkill) ([a]
gen, [a]
kill) = (([a]
gen [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
bbkill) [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
`union` [a]
bbgen, [a]
kill [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
`union` [a]
bbkill)
blockKill :: Data a => Block (Analysis a) -> [Name]
blockKill :: forall a. Data a => Block (Analysis a) -> [Name]
blockKill = Block (Analysis a) -> [Name]
forall a. Data a => Block (Analysis a) -> [Name]
blockVarDefs
blockGen :: Data a => Block (Analysis a) -> [Name]
blockGen :: forall a. Data a => Block (Analysis a) -> [Name]
blockGen = Block (Analysis a) -> [Name]
forall a. Data a => Block (Analysis a) -> [Name]
blockVarUses
reachingDefinitions :: Data a => DefMap -> BBGr (Analysis a) -> InOutMap ASTBlockNodeSet
reachingDefinitions :: forall a.
Data a =>
DefMap -> BBGr (Analysis a) -> IntMap (BBNodeSet, BBNodeSet)
reachingDefinitions DefMap
dm BBGr (Analysis a)
gr = BBGr (Analysis a)
-> (Int -> (BBNodeSet, BBNodeSet))
-> OrderF (Analysis a)
-> (OutF BBNodeSet -> OutF BBNodeSet)
-> (OutF BBNodeSet -> OutF BBNodeSet)
-> IntMap (BBNodeSet, BBNodeSet)
forall t a.
(NFData t, Ord t) =>
BBGr a
-> (Int -> InOut t)
-> OrderF a
-> (OutF t -> OutF t)
-> (OutF t -> OutF t)
-> InOutMap t
dataFlowSolver BBGr (Analysis a)
gr ((BBNodeSet, BBNodeSet) -> Int -> (BBNodeSet, BBNodeSet)
forall a b. a -> b -> a
const (BBNodeSet
IS.empty, BBNodeSet
IS.empty)) OrderF (Analysis a)
forall a. OrderF a
revPostOrder OutF BBNodeSet -> OutF BBNodeSet
inn OutF BBNodeSet -> OutF BBNodeSet
out
where
inn :: OutF BBNodeSet -> OutF BBNodeSet
inn OutF BBNodeSet
outF Int
b = [BBNodeSet] -> BBNodeSet
forall (f :: * -> *). Foldable f => f BBNodeSet -> BBNodeSet
IS.unions [ OutF BBNodeSet
outF Int
s | Int
s <- Gr (BB (Analysis a)) () -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
pre (BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
b ]
out :: OutF BBNodeSet -> OutF BBNodeSet
out OutF BBNodeSet
innF Int
b = BBNodeSet
gen BBNodeSet -> BBNodeSet -> BBNodeSet
`IS.union` (OutF BBNodeSet
innF Int
b BBNodeSet -> BBNodeSet -> BBNodeSet
IS.\\ BBNodeSet
kill)
where (BBNodeSet
gen, BBNodeSet
kill) = DefMap -> BB (Analysis a) -> (BBNodeSet, BBNodeSet)
forall a.
Data a =>
DefMap -> [Block (Analysis a)] -> (BBNodeSet, BBNodeSet)
rdBblockGenKill DefMap
dm (Name -> Maybe (BB (Analysis a)) -> BB (Analysis a)
forall a. Name -> Maybe a -> a
fromJustMsg Name
"reachingDefinitions" (Maybe (BB (Analysis a)) -> BB (Analysis a))
-> Maybe (BB (Analysis a)) -> BB (Analysis a)
forall a b. (a -> b) -> a -> b
$ Gr (BB (Analysis a)) () -> Int -> Maybe (BB (Analysis a))
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
b)
rdBblockGenKill :: Data a => DefMap -> [Block (Analysis a)] -> (ASTBlockNodeSet, ASTBlockNodeSet)
rdBblockGenKill :: forall a.
Data a =>
DefMap -> [Block (Analysis a)] -> (BBNodeSet, BBNodeSet)
rdBblockGenKill DefMap
dm [Block (Analysis a)]
bs = ((BBNodeSet, BBNodeSet)
-> (BBNodeSet, BBNodeSet) -> (BBNodeSet, BBNodeSet))
-> (BBNodeSet, BBNodeSet)
-> [(BBNodeSet, BBNodeSet)]
-> (BBNodeSet, BBNodeSet)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (BBNodeSet, BBNodeSet)
-> (BBNodeSet, BBNodeSet) -> (BBNodeSet, BBNodeSet)
f (BBNodeSet
IS.empty, BBNodeSet
IS.empty) ([(BBNodeSet, BBNodeSet)] -> (BBNodeSet, BBNodeSet))
-> [(BBNodeSet, BBNodeSet)] -> (BBNodeSet, BBNodeSet)
forall a b. (a -> b) -> a -> b
$ (Block (Analysis a) -> (BBNodeSet, BBNodeSet))
-> [Block (Analysis a)] -> [(BBNodeSet, BBNodeSet)]
forall a b. (a -> b) -> [a] -> [b]
map (Block (Analysis a) -> BBNodeSet
forall {a}. Data a => Block (Analysis a) -> BBNodeSet
gen (Block (Analysis a) -> BBNodeSet)
-> (Block (Analysis a) -> BBNodeSet)
-> Block (Analysis a)
-> (BBNodeSet, BBNodeSet)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Block (Analysis a) -> BBNodeSet
kill) [Block (Analysis a)]
bs
where
gen :: Block (Analysis a) -> BBNodeSet
gen Block (Analysis a)
b | [Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Block (Analysis a) -> [Name]
forall a. Data a => Block (Analysis a) -> [Name]
allLhsVars Block (Analysis a)
b) = BBNodeSet
IS.empty
| Bool
otherwise = OutF BBNodeSet
IS.singleton OutF BBNodeSet
-> (Block (Analysis a) -> Int) -> Block (Analysis a) -> BBNodeSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Maybe Int -> Int
forall a. Name -> Maybe a -> a
fromJustMsg Name
"rdBblockGenKill" (Maybe Int -> Int)
-> (Block (Analysis a) -> Maybe Int) -> Block (Analysis a) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Analysis a -> Maybe Int
forall a. Analysis a -> Maybe Int
insLabel (Analysis a -> Maybe Int)
-> (Block (Analysis a) -> Analysis a)
-> Block (Analysis a)
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation (Block (Analysis a) -> BBNodeSet)
-> Block (Analysis a) -> BBNodeSet
forall a b. (a -> b) -> a -> b
$ Block (Analysis a)
b
kill :: Block (Analysis a) -> BBNodeSet
kill = DefMap -> Block (Analysis a) -> BBNodeSet
forall a. Data a => DefMap -> Block (Analysis a) -> BBNodeSet
rdDefs DefMap
dm
f :: (BBNodeSet, BBNodeSet)
-> (BBNodeSet, BBNodeSet) -> (BBNodeSet, BBNodeSet)
f (BBNodeSet
bbgen, BBNodeSet
bbkill) (BBNodeSet
gen', BBNodeSet
kill') =
((BBNodeSet
bbgen BBNodeSet -> BBNodeSet -> BBNodeSet
IS.\\ BBNodeSet
kill') BBNodeSet -> BBNodeSet -> BBNodeSet
`IS.union` BBNodeSet
gen', (BBNodeSet
bbkill BBNodeSet -> BBNodeSet -> BBNodeSet
IS.\\ BBNodeSet
gen') BBNodeSet -> BBNodeSet -> BBNodeSet
`IS.union` BBNodeSet
kill')
rdDefs :: Data a => DefMap -> Block (Analysis a) -> ASTBlockNodeSet
rdDefs :: forall a. Data a => DefMap -> Block (Analysis a) -> BBNodeSet
rdDefs DefMap
dm Block (Analysis a)
b = [BBNodeSet] -> BBNodeSet
forall (f :: * -> *). Foldable f => f BBNodeSet -> BBNodeSet
IS.unions [ BBNodeSet
IS.empty BBNodeSet -> Maybe BBNodeSet -> BBNodeSet
forall a. a -> Maybe a -> a
`fromMaybe` Name -> DefMap -> Maybe BBNodeSet
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
y DefMap
dm | Name
y <- Block (Analysis a) -> [Name]
forall a. Data a => Block (Analysis a) -> [Name]
allLhsVars Block (Analysis a)
b ]
type DUMap = ASTBlockNodeMap ASTBlockNodeSet
genDUMap :: Data a => BlockMap a -> DefMap -> BBGr (Analysis a) -> InOutMap ASTBlockNodeSet -> DUMap
genDUMap :: forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> DomMap
genDUMap BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr IntMap (BBNodeSet, BBNodeSet)
rdefs = (BBNodeSet -> BBNodeSet -> BBNodeSet) -> [DomMap] -> DomMap
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IM.unionsWith BBNodeSet -> BBNodeSet -> BBNodeSet
IS.union [DomMap]
duMaps
where
duMaps :: [DomMap]
duMaps = [ (DomMap, BBNodeSet) -> DomMap
forall a b. (a, b) -> a
fst (((DomMap, BBNodeSet) -> Block (Analysis a) -> (DomMap, BBNodeSet))
-> (DomMap, BBNodeSet)
-> [Block (Analysis a)]
-> (DomMap, BBNodeSet)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (DomMap, BBNodeSet) -> Block (Analysis a) -> (DomMap, BBNodeSet)
forall {a}.
Data a =>
(DomMap, BBNodeSet) -> Block (Analysis a) -> (DomMap, BBNodeSet)
inBBlock (DomMap
forall a. IntMap a
IM.empty, BBNodeSet
is) [Block (Analysis a)]
bs) |
(Int
n, (BBNodeSet
is, BBNodeSet
_)) <- IntMap (BBNodeSet, BBNodeSet) -> [(Int, (BBNodeSet, BBNodeSet))]
forall a. IntMap a -> [(Int, a)]
IM.toList IntMap (BBNodeSet, BBNodeSet)
rdefs,
let Just [Block (Analysis a)]
bs = Gr [Block (Analysis a)] () -> Int -> Maybe [Block (Analysis a)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (BBGr (Analysis a) -> Gr [Block (Analysis a)] ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
n ]
inBBlock :: (DomMap, BBNodeSet) -> Block (Analysis a) -> (DomMap, BBNodeSet)
inBBlock (DomMap
duMap, BBNodeSet
inSet) Block (Analysis a)
b = (DomMap
duMap', BBNodeSet
inSet')
where
Just Int
i = Analysis a -> Maybe Int
forall a. Analysis a -> Maybe Int
insLabel (Block (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Block (Analysis a)
b)
bduMap :: DomMap
bduMap = (BBNodeSet -> BBNodeSet -> BBNodeSet)
-> [(Int, BBNodeSet)] -> DomMap
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith BBNodeSet -> BBNodeSet -> BBNodeSet
IS.union [ (Int
i', OutF BBNodeSet
IS.singleton Int
i) | Int
i' <- BBNodeSet -> [Int]
IS.toList BBNodeSet
inSet, Int -> Bool
overlap Int
i' ]
overlap :: Int -> Bool
overlap Int
i' = Bool -> Bool
not (Bool -> Bool) -> ([Name] -> Bool) -> [Name] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Name] -> Bool) -> ([Name] -> [Name]) -> [Name] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
intersect [Name]
uses ([Name] -> Bool) -> [Name] -> Bool
forall a b. (a -> b) -> a -> b
$ Block (Analysis a) -> [Name]
forall a. Data a => Block (Analysis a) -> [Name]
blockVarDefs Block (Analysis a)
b'
where Just Block (Analysis a)
b' = Int -> BlockMap a -> Maybe (Block (Analysis a))
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i' BlockMap a
bm
uses :: [Name]
uses = Block (Analysis a) -> [Name]
forall a. Data a => Block (Analysis a) -> [Name]
blockVarUses Block (Analysis a)
b
duMap' :: DomMap
duMap' = (BBNodeSet -> BBNodeSet -> BBNodeSet) -> DomMap -> DomMap -> DomMap
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith BBNodeSet -> BBNodeSet -> BBNodeSet
IS.union DomMap
duMap DomMap
bduMap
gen :: Block (Analysis a) -> BBNodeSet
gen Block (Analysis a)
b' | [Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Block (Analysis a) -> [Name]
forall a. Data a => Block (Analysis a) -> [Name]
allLhsVars Block (Analysis a)
b') = BBNodeSet
IS.empty
| Bool
otherwise = OutF BBNodeSet
IS.singleton OutF BBNodeSet
-> (Block (Analysis a) -> Int) -> Block (Analysis a) -> BBNodeSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Maybe Int -> Int
forall a. Name -> Maybe a -> a
fromJustMsg Name
"genDUMap" (Maybe Int -> Int)
-> (Block (Analysis a) -> Maybe Int) -> Block (Analysis a) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Analysis a -> Maybe Int
forall a. Analysis a -> Maybe Int
insLabel (Analysis a -> Maybe Int)
-> (Block (Analysis a) -> Analysis a)
-> Block (Analysis a)
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation (Block (Analysis a) -> BBNodeSet)
-> Block (Analysis a) -> BBNodeSet
forall a b. (a -> b) -> a -> b
$ Block (Analysis a)
b'
kill :: Block (Analysis a) -> BBNodeSet
kill = DefMap -> Block (Analysis a) -> BBNodeSet
forall a. Data a => DefMap -> Block (Analysis a) -> BBNodeSet
rdDefs DefMap
dm
inSet' :: BBNodeSet
inSet' = (BBNodeSet
inSet BBNodeSet -> BBNodeSet -> BBNodeSet
IS.\\ Block (Analysis a) -> BBNodeSet
kill Block (Analysis a)
b) BBNodeSet -> BBNodeSet -> BBNodeSet
`IS.union` Block (Analysis a) -> BBNodeSet
forall {a}. Data a => Block (Analysis a) -> BBNodeSet
gen Block (Analysis a)
b
type UDMap = ASTBlockNodeMap ASTBlockNodeSet
duMapToUdMap :: DUMap -> UDMap
duMapToUdMap :: DomMap -> DomMap
duMapToUdMap DomMap
duMap = (BBNodeSet -> BBNodeSet -> BBNodeSet)
-> [(Int, BBNodeSet)] -> DomMap
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith BBNodeSet -> BBNodeSet -> BBNodeSet
IS.union [
(Int
use, OutF BBNodeSet
IS.singleton Int
def) | (Int
def, BBNodeSet
uses) <- DomMap -> [(Int, BBNodeSet)]
forall a. IntMap a -> [(Int, a)]
IM.toList DomMap
duMap, Int
use <- BBNodeSet -> [Int]
IS.toList BBNodeSet
uses
]
genUDMap :: Data a => BlockMap a -> DefMap -> BBGr (Analysis a) -> InOutMap ASTBlockNodeSet -> UDMap
genUDMap :: forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> DomMap
genUDMap BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr = DomMap -> DomMap
duMapToUdMap (DomMap -> DomMap)
-> (IntMap (BBNodeSet, BBNodeSet) -> DomMap)
-> IntMap (BBNodeSet, BBNodeSet)
-> DomMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> DomMap
forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> DomMap
genDUMap BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr
mapToGraph :: DynGraph gr => BlockMap a -> ASTBlockNodeMap ASTBlockNodeSet -> gr (Block (Analysis a)) ()
mapToGraph :: forall (gr :: * -> * -> *) a.
DynGraph gr =>
BlockMap a -> DomMap -> gr (Block (Analysis a)) ()
mapToGraph BlockMap a
bm DomMap
m = [LNode (Block (Analysis a))]
-> [LEdge ()] -> gr (Block (Analysis a)) ()
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode (Block (Analysis a))]
nodes' [LEdge ()]
edges'
where
nodes' :: [LNode (Block (Analysis a))]
nodes' = [ (Int
i, Block (Analysis a)
iLabel) | Int
i <- DomMap -> [Int]
forall a. IntMap a -> [Int]
IM.keys DomMap
m [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (BBNodeSet -> [Int]) -> [BBNodeSet] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BBNodeSet -> [Int]
IS.toList (DomMap -> [BBNodeSet]
forall a. IntMap a -> [a]
IM.elems DomMap
m)
, let iLabel :: Block (Analysis a)
iLabel = Name -> Maybe (Block (Analysis a)) -> Block (Analysis a)
forall a. Name -> Maybe a -> a
fromJustMsg Name
"mapToGraph" (Int -> BlockMap a -> Maybe (Block (Analysis a))
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i BlockMap a
bm) ]
edges' :: [LEdge ()]
edges' = [ (Int
i, Int
j, ()) | (Int
i, BBNodeSet
js) <- DomMap -> [(Int, BBNodeSet)]
forall a. IntMap a -> [(Int, a)]
IM.toList DomMap
m
, Int
j <- BBNodeSet -> [Int]
IS.toList BBNodeSet
js ]
type FlowsGraph a = Gr (Block (Analysis a)) ()
genFlowsToGraph :: Data a => BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> InOutMap ASTBlockNodeSet
-> FlowsGraph a
genFlowsToGraph :: forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> FlowsGraph a
genFlowsToGraph BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr = BlockMap a -> DomMap -> Gr (Block (Analysis a)) ()
forall (gr :: * -> * -> *) a.
DynGraph gr =>
BlockMap a -> DomMap -> gr (Block (Analysis a)) ()
mapToGraph BlockMap a
bm (DomMap -> Gr (Block (Analysis a)) ())
-> (IntMap (BBNodeSet, BBNodeSet) -> DomMap)
-> IntMap (BBNodeSet, BBNodeSet)
-> Gr (Block (Analysis a)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> DomMap
forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> DomMap
genDUMap BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr
type VarFlowsMap = M.Map Name (S.Set Name)
genVarFlowsToMap :: Data a => DefMap -> FlowsGraph a -> VarFlowsMap
genVarFlowsToMap :: forall a. Data a => DefMap -> FlowsGraph a -> VarFlowsMap
genVarFlowsToMap DefMap
dm FlowsGraph a
fg = (Set Name -> Set Name -> Set Name)
-> [(Name, Set Name)] -> VarFlowsMap
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.union [ (Int -> Name
conv Int
u, OutF (Set Name)
sconv Int
v) | (Int
u, Int
v) <- FlowsGraph a -> [(Int, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [(Int, Int)]
edges FlowsGraph a
fg ]
where
sconv :: OutF (Set Name)
sconv Int
i | Just Name
v <- Int -> IntMap Name -> Maybe Name
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i IntMap Name
revDM = Name -> Set Name
forall a. a -> Set a
S.singleton Name
v
| Bool
otherwise = Set Name
forall a. Set a
S.empty
conv :: Int -> Name
conv Int
i | Just Name
v <- Int -> IntMap Name -> Maybe Name
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i IntMap Name
revDM = Name
v
| Bool
otherwise = Name -> Name
forall a. HasCallStack => Name -> a
error (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Name
"genVarFlowsToMap: convert failed, i=" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Int -> Name
forall a. Show a => a -> Name
show Int
i
revDM :: IntMap Name
revDM = (Name -> Name -> Name) -> [(Int, Name)] -> IntMap Name
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith (((Name, Name) -> Name) -> Name -> Name -> Name
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Name, Name) -> Name
forall a b. (a, b) -> a
fst) [ (Int
i, Name
v) | (Name
v, BBNodeSet
is) <- DefMap -> [(Name, BBNodeSet)]
forall k a. Map k a -> [(k, a)]
M.toList DefMap
dm, Int
i <- BBNodeSet -> [Int]
IS.toList BBNodeSet
is ]
minConst :: Integer
minConst :: Integer
minConst = (-Integer
2::Integer) Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
31::Integer)
maxConst :: Integer
maxConst :: Integer
maxConst = (Integer
2::Integer) Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
31::Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer
1::Integer)
inBounds :: Integer -> Bool
inBounds :: Integer -> Bool
inBounds Integer
x = Integer
minConst Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
x Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxConst
constantFolding :: Constant -> Constant
constantFolding :: Constant -> Constant
constantFolding Constant
c = case Constant
c of
ConstBinary BinaryOp
binOp Constant
a Constant
b | ConstInt Integer
x <- Constant -> Constant
constantFolding Constant
a
, ConstInt Integer
y <- Constant -> Constant
constantFolding Constant
b -> case BinaryOp
binOp of
BinaryOp
Addition | Integer -> Bool
inBounds (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y) -> Integer -> Constant
ConstInt (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y)
BinaryOp
Subtraction | Integer -> Bool
inBounds (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y) -> Integer -> Constant
ConstInt (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y)
BinaryOp
Multiplication | Integer -> Bool
inBounds (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y) -> Integer -> Constant
ConstInt (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y)
BinaryOp
Division | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 -> Integer -> Constant
ConstInt (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
y)
BinaryOp
Exponentiation | Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> Integer -> Constant
ConstInt (Integer
x Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
y)
BinaryOp
_ -> BinaryOp -> Constant -> Constant -> Constant
ConstBinary BinaryOp
binOp (Integer -> Constant
ConstInt Integer
x) (Integer -> Constant
ConstInt Integer
y)
ConstUnary UnaryOp
Minus Constant
a | ConstInt Integer
x <- Constant -> Constant
constantFolding Constant
a -> Integer -> Constant
ConstInt (-Integer
x)
ConstUnary UnaryOp
Plus Constant
a -> Constant -> Constant
constantFolding Constant
a
Constant
_ -> Constant
c
type ParameterVarMap = M.Map Name Constant
type ConstExpMap = ASTExprNodeMap (Maybe Constant)
genConstExpMap :: forall a. Data a => ProgramFile (Analysis a) -> ConstExpMap
genConstExpMap :: forall a. Data a => ProgramFile (Analysis a) -> ConstExpMap
genConstExpMap ProgramFile (Analysis a)
pf = ConstExpMap
ceMap
where
pvMap :: Map Name (Maybe Constant)
pvMap = [(Name, Maybe Constant)] -> Map Name (Maybe Constant)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Maybe Constant)] -> Map Name (Maybe Constant))
-> [(Name, Maybe Constant)] -> Map Name (Maybe Constant)
forall a b. (a -> b) -> a -> b
$
[ (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v, Expression (Analysis a) -> Maybe Constant
getE Expression (Analysis a)
e)
| st :: Statement (Analysis a)
st@(StDeclaration Analysis a
_ SrcSpan
_ (TypeSpec Analysis a
_ SrcSpan
_ BaseType
_ Maybe (Selector (Analysis a))
_) Maybe (AList Attribute (Analysis a))
_ AList Declarator (Analysis a)
_) <- ProgramFile (Analysis a) -> [Statement (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile (Analysis a)
pf :: [Statement (Analysis a)]
, AttrParameter Analysis a
_ SrcSpan
_ <- Statement (Analysis a) -> [Attribute (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi Statement (Analysis a)
st :: [Attribute (Analysis a)]
, (Declarator Analysis a
_ SrcSpan
_ Expression (Analysis a)
v DeclaratorType (Analysis a)
ScalarDecl Maybe (Expression (Analysis a))
_ (Just Expression (Analysis a)
e)) <- Statement (Analysis a) -> [Declarator (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi Statement (Analysis a)
st ] [(Name, Maybe Constant)]
-> [(Name, Maybe Constant)] -> [(Name, Maybe Constant)]
forall a. [a] -> [a] -> [a]
++
[ (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v, Expression (Analysis a) -> Maybe Constant
getE Expression (Analysis a)
e)
| st :: Statement (Analysis a)
st@StParameter{} <- ProgramFile (Analysis a) -> [Statement (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile (Analysis a)
pf :: [Statement (Analysis a)]
, (Declarator Analysis a
_ SrcSpan
_ Expression (Analysis a)
v DeclaratorType (Analysis a)
ScalarDecl Maybe (Expression (Analysis a))
_ (Just Expression (Analysis a)
e)) <- Statement (Analysis a) -> [Declarator (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi Statement (Analysis a)
st ]
getV :: Expression (Analysis a) -> Maybe Constant
getV :: Expression (Analysis a) -> Maybe Constant
getV Expression (Analysis a)
e = Analysis a -> Maybe Constant
forall a. Analysis a -> Maybe Constant
constExp (Expression (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
e) Maybe Constant -> Maybe Constant -> Maybe Constant
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (Maybe (Maybe Constant) -> Maybe Constant
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Constant) -> Maybe Constant)
-> (Expression (Analysis a) -> Maybe (Maybe Constant))
-> Expression (Analysis a)
-> Maybe Constant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Map Name (Maybe Constant) -> Maybe (Maybe Constant))
-> Map Name (Maybe Constant) -> Name -> Maybe (Maybe Constant)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> Map Name (Maybe Constant) -> Maybe (Maybe Constant)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Name (Maybe Constant)
pvMap (Name -> Maybe (Maybe Constant))
-> (Expression (Analysis a) -> Name)
-> Expression (Analysis a)
-> Maybe (Maybe Constant)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName (Expression (Analysis a) -> Maybe Constant)
-> Expression (Analysis a) -> Maybe Constant
forall a b. (a -> b) -> a -> b
$ Expression (Analysis a)
e)
ceMap :: ConstExpMap
ceMap = [(Int, Maybe Constant)] -> ConstExpMap
forall a. [(Int, a)] -> IntMap a
IM.fromList [ (Int
label, Expression (Analysis a) -> Maybe Constant
doExpr Expression (Analysis a)
e) | Expression (Analysis a)
e <- ProgramFile (Analysis a) -> [Expression (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile (Analysis a)
pf, Just Int
label <- [Expression (Analysis a) -> Maybe Int
forall {a}. Expression (Analysis a) -> Maybe Int
labelOf Expression (Analysis a)
e] ]
getE :: Expression (Analysis a) -> Maybe Constant
getE :: Expression (Analysis a) -> Maybe Constant
getE = Maybe (Maybe Constant) -> Maybe Constant
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Constant) -> Maybe Constant)
-> (Expression (Analysis a) -> Maybe (Maybe Constant))
-> Expression (Analysis a)
-> Maybe Constant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int -> ConstExpMap -> Maybe (Maybe Constant))
-> ConstExpMap -> Int -> Maybe (Maybe Constant)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> ConstExpMap -> Maybe (Maybe Constant)
forall a. Int -> IntMap a -> Maybe a
IM.lookup ConstExpMap
ceMap (Int -> Maybe (Maybe Constant))
-> (Expression (Analysis a) -> Maybe Int)
-> Expression (Analysis a)
-> Maybe (Maybe Constant)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Expression (Analysis a) -> Maybe Int
forall {a}. Expression (Analysis a) -> Maybe Int
labelOf)
labelOf :: Expression (Analysis a) -> Maybe Int
labelOf = Analysis a -> Maybe Int
forall a. Analysis a -> Maybe Int
insLabel (Analysis a -> Maybe Int)
-> (Expression (Analysis a) -> Analysis a)
-> Expression (Analysis a)
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation
doExpr :: Expression (Analysis a) -> Maybe Constant
doExpr :: Expression (Analysis a) -> Maybe Constant
doExpr Expression (Analysis a)
e = case Expression (Analysis a)
e of
ExpValue Analysis a
_ SrcSpan
_ (ValInteger Name
intStr Maybe (KindParam (Analysis a))
_) -> Constant -> Maybe Constant
forall a. a -> Maybe a
Just (Constant -> Maybe Constant)
-> (Integer -> Constant) -> Integer -> Maybe Constant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Constant
ConstInt (Integer -> Maybe Constant) -> Integer -> Maybe Constant
forall a b. (a -> b) -> a -> b
$ Name -> Integer
forall a. Read a => Name -> a
read Name
intStr
ExpValue Analysis a
_ SrcSpan
_ (ValReal RealLit
r Maybe (KindParam (Analysis a))
_) -> Constant -> Maybe Constant
forall a. a -> Maybe a
Just (Constant -> Maybe Constant) -> Constant -> Maybe Constant
forall a b. (a -> b) -> a -> b
$ Name -> Constant
ConstUninterpReal (RealLit -> Name
prettyHsRealLit RealLit
r)
ExpValue Analysis a
_ SrcSpan
_ (ValVariable Name
_) -> Expression (Analysis a) -> Maybe Constant
getV Expression (Analysis a)
e
ExpBinary Analysis a
_ SrcSpan
_ BinaryOp
binOp Expression (Analysis a)
e1 Expression (Analysis a)
e2 -> Constant -> Constant
constantFolding (Constant -> Constant) -> Maybe Constant -> Maybe Constant
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Constant -> Constant -> Constant)
-> Maybe Constant -> Maybe Constant -> Maybe Constant
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (BinaryOp -> Constant -> Constant -> Constant
ConstBinary BinaryOp
binOp) (Expression (Analysis a) -> Maybe Constant
getE Expression (Analysis a)
e1) (Expression (Analysis a) -> Maybe Constant
getE Expression (Analysis a)
e2)
ExpUnary Analysis a
_ SrcSpan
_ UnaryOp
unOp Expression (Analysis a)
e' -> Constant -> Constant
constantFolding (Constant -> Constant)
-> (Constant -> Constant) -> Constant -> Constant
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnaryOp -> Constant -> Constant
ConstUnary UnaryOp
unOp (Constant -> Constant) -> Maybe Constant -> Maybe Constant
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression (Analysis a) -> Maybe Constant
getE Expression (Analysis a)
e'
Expression (Analysis a)
_ -> Maybe Constant
forall a. Maybe a
Nothing
analyseConstExps :: forall a. Data a => ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseConstExps :: forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseConstExps ProgramFile (Analysis a)
pf = ProgramFile (Analysis a)
pf'
where
ceMap :: ConstExpMap
ceMap = ProgramFile (Analysis a) -> ConstExpMap
forall a. Data a => ProgramFile (Analysis a) -> ConstExpMap
genConstExpMap ProgramFile (Analysis a)
pf
pf' :: ProgramFile (Analysis a)
pf' = (BBGr (Analysis a) -> BBGr (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
transformBB ((Gr [Block (Analysis a)] () -> Gr [Block (Analysis a)] ())
-> BBGr (Analysis a) -> BBGr (Analysis a)
forall a b. (Gr (BB a) () -> Gr (BB b) ()) -> BBGr a -> BBGr b
bbgrMap (([Block (Analysis a)] -> [Block (Analysis a)])
-> Gr [Block (Analysis a)] () -> Gr [Block (Analysis a)] ()
forall (gr :: * -> * -> *) a c b.
DynGraph gr =>
(a -> c) -> gr a b -> gr c b
nmap ((Expression (Analysis a) -> Expression (Analysis a))
-> [Block (Analysis a)] -> [Block (Analysis a)]
transformExpr Expression (Analysis a) -> Expression (Analysis a)
insertConstExp))) (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a b. (a -> b) -> a -> b
$ (Expression (Analysis a) -> Expression (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi Expression (Analysis a) -> Expression (Analysis a)
insertConstExp ProgramFile (Analysis a)
pf
insertConstExp :: Expression (Analysis a) -> Expression (Analysis a)
insertConstExp :: Expression (Analysis a) -> Expression (Analysis a)
insertConstExp Expression (Analysis a)
e = ((Analysis a -> Analysis a)
-> Expression (Analysis a) -> Expression (Analysis a))
-> Expression (Analysis a)
-> (Analysis a -> Analysis a)
-> Expression (Analysis a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Analysis a -> Analysis a)
-> Expression (Analysis a) -> Expression (Analysis a)
forall (f :: * -> *) a. Annotated f => (a -> a) -> f a -> f a
modifyAnnotation Expression (Analysis a)
e ((Analysis a -> Analysis a) -> Expression (Analysis a))
-> (Analysis a -> Analysis a) -> Expression (Analysis a)
forall a b. (a -> b) -> a -> b
$ \ Analysis a
a ->
Analysis a
a { constExp :: Maybe Constant
constExp = Analysis a -> Maybe Constant
forall a. Analysis a -> Maybe Constant
constExp Analysis a
a Maybe Constant -> Maybe Constant -> Maybe Constant
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe (Maybe Constant) -> Maybe Constant
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((Int -> ConstExpMap -> Maybe (Maybe Constant))
-> ConstExpMap -> Int -> Maybe (Maybe Constant)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> ConstExpMap -> Maybe (Maybe Constant)
forall a. Int -> IntMap a -> Maybe a
IM.lookup ConstExpMap
ceMap (Int -> Maybe (Maybe Constant))
-> Maybe Int -> Maybe (Maybe Constant)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Analysis a -> Maybe Int
forall a. Analysis a -> Maybe Int
insLabel (Expression (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
e)) }
transformBB :: (BBGr (Analysis a) -> BBGr (Analysis a)) -> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
transformBB :: (BBGr (Analysis a) -> BBGr (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
transformBB = (BBGr (Analysis a) -> BBGr (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi
transformExpr :: (Expression (Analysis a) -> Expression (Analysis a)) ->
[Block (Analysis a)] -> [Block (Analysis a)]
transformExpr :: (Expression (Analysis a) -> Expression (Analysis a))
-> [Block (Analysis a)] -> [Block (Analysis a)]
transformExpr = (Expression (Analysis a) -> Expression (Analysis a))
-> [Block (Analysis a)] -> [Block (Analysis a)]
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi
analyseParameterVars :: forall a. Data a => ParameterVarMap -> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseParameterVars :: forall a.
Data a =>
ParameterVarMap
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseParameterVars ParameterVarMap
pvm = (Expression (Analysis a) -> Expression (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi Expression (Analysis a) -> Expression (Analysis a)
expr
where
expr :: Expression (Analysis a) -> Expression (Analysis a)
expr :: Expression (Analysis a) -> Expression (Analysis a)
expr e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ ValVariable{})
| Just Constant
con <- Name -> ParameterVarMap -> Maybe Constant
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
e) ParameterVarMap
pvm = ((Analysis a -> Analysis a)
-> Expression (Analysis a) -> Expression (Analysis a))
-> Expression (Analysis a)
-> (Analysis a -> Analysis a)
-> Expression (Analysis a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Analysis a -> Analysis a)
-> Expression (Analysis a) -> Expression (Analysis a)
forall (f :: * -> *) a. Annotated f => (a -> a) -> f a -> f a
modifyAnnotation Expression (Analysis a)
e ((Analysis a -> Analysis a) -> Expression (Analysis a))
-> (Analysis a -> Analysis a) -> Expression (Analysis a)
forall a b. (a -> b) -> a -> b
$ \ Analysis a
a -> Analysis a
a { constExp :: Maybe Constant
constExp = Constant -> Maybe Constant
forall a. a -> Maybe a
Just Constant
con }
expr Expression (Analysis a)
e = Expression (Analysis a)
e
type BackEdgeMap = BBNodeMap BBNode
genBackEdgeMap :: Graph gr => DomMap -> gr a b -> BackEdgeMap
genBackEdgeMap :: forall (gr :: * -> * -> *) a b.
Graph gr =>
DomMap -> gr a b -> IDomMap
genBackEdgeMap DomMap
domMap = [(Int, Int)] -> IDomMap
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, Int)] -> IDomMap)
-> (gr a b -> [(Int, Int)]) -> gr a b -> IDomMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, Int) -> Bool
isBackEdge ([(Int, Int)] -> [(Int, Int)])
-> (gr a b -> [(Int, Int)]) -> gr a b -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [(Int, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [(Int, Int)]
edges
where
isBackEdge :: (Int, Int) -> Bool
isBackEdge (Int
s, Int
t) = Int
t Int -> BBNodeSet -> Bool
`IS.member` Name -> Maybe BBNodeSet -> BBNodeSet
forall a. Name -> Maybe a -> a
fromJustMsg Name
"genBackEdgeMap" (Int
s Int -> DomMap -> Maybe BBNodeSet
forall a. Int -> IntMap a -> Maybe a
`IM.lookup` DomMap
domMap)
loopNodes :: Graph gr => BackEdgeMap -> gr a b -> [BBNodeSet]
loopNodes :: forall (gr :: * -> * -> *) a b.
Graph gr =>
IDomMap -> gr a b -> [BBNodeSet]
loopNodes IDomMap
bedges gr a b
gr = [
[Int] -> BBNodeSet
IS.fromList (Int
nInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
intersect (Int -> gr a b -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> [Int]
sccWith Int
n gr a b
gr) ([Int] -> gr a b -> [Int]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> [Int]
rdfs [Int
m] (Int -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> gr a b
delNode Int
n gr a b
gr))) | (Int
m, Int
n) <- IDomMap -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
IM.toList IDomMap
bedges
]
type LoopNodeMap = BBNodeMap BBNodeSet
genLoopNodeMap :: Graph gr => BackEdgeMap -> gr a b -> LoopNodeMap
genLoopNodeMap :: forall (gr :: * -> * -> *) a b.
Graph gr =>
IDomMap -> gr a b -> DomMap
genLoopNodeMap IDomMap
bedges gr a b
gr = [(Int, BBNodeSet)] -> DomMap
forall a. [(Int, a)] -> IntMap a
IM.fromList [
(Int
n, [Int] -> BBNodeSet
IS.fromList (Int
nInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
intersect (Int -> gr a b -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> [Int]
sccWith Int
n gr a b
gr) ([Int] -> gr a b -> [Int]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> [Int]
rdfs [Int
m] (Int -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> gr a b
delNode Int
n gr a b
gr)))) | (Int
m, Int
n) <- IDomMap -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
IM.toList IDomMap
bedges
]
sccWith :: (Graph gr) => Node -> gr a b -> [Node]
sccWith :: forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> [Int]
sccWith Int
n gr a b
g = case ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int
n Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ gr a b -> [[Int]]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Int]]
scc gr a b
g of
[] -> []
[Int]
c:[[Int]]
_ -> [Int]
c
type InductionVarMap = BBNodeMap (S.Set Name)
basicInductionVars :: Data a => BackEdgeMap -> BBGr (Analysis a) -> InductionVarMap
basicInductionVars :: forall a. Data a => IDomMap -> BBGr (Analysis a) -> InductionVarMap
basicInductionVars IDomMap
bedges BBGr (Analysis a)
gr = (Set Name -> Set Name -> Set Name)
-> [(Int, Set Name)] -> InductionVarMap
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.union [
(Int
n, Name -> Set Name
forall a. a -> Set a
S.singleton Name
v) | (Int
_, Int
n) <- IDomMap -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
IM.toList IDomMap
bedges
, let Just BB (Analysis a)
bs = Gr (BB (Analysis a)) () -> Int -> Maybe (BB (Analysis a))
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
n
, b :: Block (Analysis a)
b@BlDo{} <- BB (Analysis a)
bs
, Name
v <- Block (Analysis a) -> [Name]
forall a. Data a => Block (Analysis a) -> [Name]
blockVarDefs Block (Analysis a)
b
]
genInductionVarMap :: Data a => BackEdgeMap -> BBGr (Analysis a) -> InductionVarMap
genInductionVarMap :: forall a. Data a => IDomMap -> BBGr (Analysis a) -> InductionVarMap
genInductionVarMap = IDomMap -> BBGr (Analysis a) -> InductionVarMap
forall a. Data a => IDomMap -> BBGr (Analysis a) -> InductionVarMap
basicInductionVars
type InductionVarMapByASTBlock = ASTBlockNodeMap (S.Set Name)
genInductionVarMapByASTBlock :: forall a. Data a => BackEdgeMap -> BBGr (Analysis a) -> InductionVarMapByASTBlock
genInductionVarMapByASTBlock :: forall a. Data a => IDomMap -> BBGr (Analysis a) -> InductionVarMap
genInductionVarMapByASTBlock IDomMap
bedges BBGr (Analysis a)
gr = InductionVarMap -> InductionVarMap
loopsToLabs (InductionVarMap -> InductionVarMap)
-> (BBGr (Analysis a) -> InductionVarMap)
-> BBGr (Analysis a)
-> InductionVarMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IDomMap -> BBGr (Analysis a) -> InductionVarMap
forall a. Data a => IDomMap -> BBGr (Analysis a) -> InductionVarMap
genInductionVarMap IDomMap
bedges (BBGr (Analysis a) -> InductionVarMap)
-> BBGr (Analysis a) -> InductionVarMap
forall a b. (a -> b) -> a -> b
$ BBGr (Analysis a)
gr
where
lnMap :: DomMap
lnMap = IDomMap -> Gr (BB (Analysis a)) () -> DomMap
forall (gr :: * -> * -> *) a b.
Graph gr =>
IDomMap -> gr a b -> DomMap
genLoopNodeMap IDomMap
bedges (Gr (BB (Analysis a)) () -> DomMap)
-> Gr (BB (Analysis a)) () -> DomMap
forall a b. (a -> b) -> a -> b
$ BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr
get' :: OutF BBNodeSet
get' = BBNodeSet -> Maybe BBNodeSet -> BBNodeSet
forall a. a -> Maybe a -> a
fromMaybe (Name -> BBNodeSet
forall a. HasCallStack => Name -> a
error Name
"missing loop-header node") (Maybe BBNodeSet -> BBNodeSet)
-> (Int -> Maybe BBNodeSet) -> OutF BBNodeSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> DomMap -> Maybe BBNodeSet)
-> DomMap -> Int -> Maybe BBNodeSet
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> DomMap -> Maybe BBNodeSet
forall a. Int -> IntMap a -> Maybe a
IM.lookup DomMap
lnMap
astLabels :: Int -> [Int]
astLabels Int
n = [ Int
i | Block (Analysis a)
b <- (Maybe (BB (Analysis a)) -> BB (Analysis a)
forall from to. Biplate from to => from -> [to]
universeBi :: Maybe [Block (Analysis a)] -> [Block (Analysis a)]) (Gr (BB (Analysis a)) () -> Int -> Maybe (BB (Analysis a))
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
n)
, let Just Int
i = Analysis a -> Maybe Int
forall a. Analysis a -> Maybe Int
insLabel (Block (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Block (Analysis a)
b) ]
loopsToLabs :: InductionVarMap -> InductionVarMap
loopsToLabs = (Set Name -> Set Name -> Set Name)
-> [(Int, Set Name)] -> InductionVarMap
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.union ([(Int, Set Name)] -> InductionVarMap)
-> (InductionVarMap -> [(Int, Set Name)])
-> InductionVarMap
-> InductionVarMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Set Name) -> [(Int, Set Name)])
-> [(Int, Set Name)] -> [(Int, Set Name)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, Set Name) -> [(Int, Set Name)]
forall {t}. (Int, t) -> [(Int, t)]
loopToLabs ([(Int, Set Name)] -> [(Int, Set Name)])
-> (InductionVarMap -> [(Int, Set Name)])
-> InductionVarMap
-> [(Int, Set Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InductionVarMap -> [(Int, Set Name)]
forall a. IntMap a -> [(Int, a)]
IM.toList
loopToLabs :: (Int, t) -> [(Int, t)]
loopToLabs (Int
n, t
ivs) = ((Int -> (Int, t)) -> [Int] -> [(Int, t)]
forall a b. (a -> b) -> [a] -> [b]
map (,t
ivs) ([Int] -> [(Int, t)]) -> (Int -> [Int]) -> Int -> [(Int, t)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int]
astLabels) (Int -> [(Int, t)]) -> [Int] -> [(Int, t)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BBNodeSet -> [Int]
IS.toList (OutF BBNodeSet
get' Int
n)
data InductionExpr
= IETop
| IELinear !Name !Int !Int
| IEBottom
deriving (Int -> InductionExpr -> Name -> Name
[InductionExpr] -> Name -> Name
InductionExpr -> Name
(Int -> InductionExpr -> Name -> Name)
-> (InductionExpr -> Name)
-> ([InductionExpr] -> Name -> Name)
-> Show InductionExpr
forall a.
(Int -> a -> Name -> Name)
-> (a -> Name) -> ([a] -> Name -> Name) -> Show a
showList :: [InductionExpr] -> Name -> Name
$cshowList :: [InductionExpr] -> Name -> Name
show :: InductionExpr -> Name
$cshow :: InductionExpr -> Name
showsPrec :: Int -> InductionExpr -> Name -> Name
$cshowsPrec :: Int -> InductionExpr -> Name -> Name
Show, InductionExpr -> InductionExpr -> Bool
(InductionExpr -> InductionExpr -> Bool)
-> (InductionExpr -> InductionExpr -> Bool) -> Eq InductionExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InductionExpr -> InductionExpr -> Bool
$c/= :: InductionExpr -> InductionExpr -> Bool
== :: InductionExpr -> InductionExpr -> Bool
$c== :: InductionExpr -> InductionExpr -> Bool
Eq, Eq InductionExpr
Eq InductionExpr
-> (InductionExpr -> InductionExpr -> Ordering)
-> (InductionExpr -> InductionExpr -> Bool)
-> (InductionExpr -> InductionExpr -> Bool)
-> (InductionExpr -> InductionExpr -> Bool)
-> (InductionExpr -> InductionExpr -> Bool)
-> (InductionExpr -> InductionExpr -> InductionExpr)
-> (InductionExpr -> InductionExpr -> InductionExpr)
-> Ord InductionExpr
InductionExpr -> InductionExpr -> Bool
InductionExpr -> InductionExpr -> Ordering
InductionExpr -> InductionExpr -> InductionExpr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InductionExpr -> InductionExpr -> InductionExpr
$cmin :: InductionExpr -> InductionExpr -> InductionExpr
max :: InductionExpr -> InductionExpr -> InductionExpr
$cmax :: InductionExpr -> InductionExpr -> InductionExpr
>= :: InductionExpr -> InductionExpr -> Bool
$c>= :: InductionExpr -> InductionExpr -> Bool
> :: InductionExpr -> InductionExpr -> Bool
$c> :: InductionExpr -> InductionExpr -> Bool
<= :: InductionExpr -> InductionExpr -> Bool
$c<= :: InductionExpr -> InductionExpr -> Bool
< :: InductionExpr -> InductionExpr -> Bool
$c< :: InductionExpr -> InductionExpr -> Bool
compare :: InductionExpr -> InductionExpr -> Ordering
$ccompare :: InductionExpr -> InductionExpr -> Ordering
Ord, Typeable, (forall x. InductionExpr -> Rep InductionExpr x)
-> (forall x. Rep InductionExpr x -> InductionExpr)
-> Generic InductionExpr
forall x. Rep InductionExpr x -> InductionExpr
forall x. InductionExpr -> Rep InductionExpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InductionExpr x -> InductionExpr
$cfrom :: forall x. InductionExpr -> Rep InductionExpr x
Generic, Typeable InductionExpr
Typeable InductionExpr
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InductionExpr -> c InductionExpr)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InductionExpr)
-> (InductionExpr -> Constr)
-> (InductionExpr -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InductionExpr))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InductionExpr))
-> ((forall b. Data b => b -> b) -> InductionExpr -> InductionExpr)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InductionExpr -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InductionExpr -> r)
-> (forall u. (forall d. Data d => d -> u) -> InductionExpr -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> InductionExpr -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InductionExpr -> m InductionExpr)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InductionExpr -> m InductionExpr)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InductionExpr -> m InductionExpr)
-> Data InductionExpr
InductionExpr -> DataType
InductionExpr -> Constr
(forall b. Data b => b -> b) -> InductionExpr -> InductionExpr
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> InductionExpr -> u
forall u. (forall d. Data d => d -> u) -> InductionExpr -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InductionExpr -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InductionExpr -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InductionExpr -> m InductionExpr
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InductionExpr -> m InductionExpr
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InductionExpr
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InductionExpr -> c InductionExpr
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InductionExpr)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InductionExpr)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InductionExpr -> m InductionExpr
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InductionExpr -> m InductionExpr
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InductionExpr -> m InductionExpr
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InductionExpr -> m InductionExpr
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InductionExpr -> m InductionExpr
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InductionExpr -> m InductionExpr
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InductionExpr -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InductionExpr -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> InductionExpr -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InductionExpr -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InductionExpr -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InductionExpr -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InductionExpr -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InductionExpr -> r
gmapT :: (forall b. Data b => b -> b) -> InductionExpr -> InductionExpr
$cgmapT :: (forall b. Data b => b -> b) -> InductionExpr -> InductionExpr
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InductionExpr)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InductionExpr)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InductionExpr)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InductionExpr)
dataTypeOf :: InductionExpr -> DataType
$cdataTypeOf :: InductionExpr -> DataType
toConstr :: InductionExpr -> Constr
$ctoConstr :: InductionExpr -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InductionExpr
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InductionExpr
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InductionExpr -> c InductionExpr
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InductionExpr -> c InductionExpr
Data)
instance NFData InductionExpr
type DerivedInductionMap = ASTExprNodeMap InductionExpr
data IEFlow = IEFlow { IEFlow -> Map Name InductionExpr
ieFlowVars :: M.Map Name InductionExpr, IEFlow -> DerivedInductionMap
ieFlowExprs :: !DerivedInductionMap }
deriving (Int -> IEFlow -> Name -> Name
[IEFlow] -> Name -> Name
IEFlow -> Name
(Int -> IEFlow -> Name -> Name)
-> (IEFlow -> Name) -> ([IEFlow] -> Name -> Name) -> Show IEFlow
forall a.
(Int -> a -> Name -> Name)
-> (a -> Name) -> ([a] -> Name -> Name) -> Show a
showList :: [IEFlow] -> Name -> Name
$cshowList :: [IEFlow] -> Name -> Name
show :: IEFlow -> Name
$cshow :: IEFlow -> Name
showsPrec :: Int -> IEFlow -> Name -> Name
$cshowsPrec :: Int -> IEFlow -> Name -> Name
Show, IEFlow -> IEFlow -> Bool
(IEFlow -> IEFlow -> Bool)
-> (IEFlow -> IEFlow -> Bool) -> Eq IEFlow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IEFlow -> IEFlow -> Bool
$c/= :: IEFlow -> IEFlow -> Bool
== :: IEFlow -> IEFlow -> Bool
$c== :: IEFlow -> IEFlow -> Bool
Eq, Eq IEFlow
Eq IEFlow
-> (IEFlow -> IEFlow -> Ordering)
-> (IEFlow -> IEFlow -> Bool)
-> (IEFlow -> IEFlow -> Bool)
-> (IEFlow -> IEFlow -> Bool)
-> (IEFlow -> IEFlow -> Bool)
-> (IEFlow -> IEFlow -> IEFlow)
-> (IEFlow -> IEFlow -> IEFlow)
-> Ord IEFlow
IEFlow -> IEFlow -> Bool
IEFlow -> IEFlow -> Ordering
IEFlow -> IEFlow -> IEFlow
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IEFlow -> IEFlow -> IEFlow
$cmin :: IEFlow -> IEFlow -> IEFlow
max :: IEFlow -> IEFlow -> IEFlow
$cmax :: IEFlow -> IEFlow -> IEFlow
>= :: IEFlow -> IEFlow -> Bool
$c>= :: IEFlow -> IEFlow -> Bool
> :: IEFlow -> IEFlow -> Bool
$c> :: IEFlow -> IEFlow -> Bool
<= :: IEFlow -> IEFlow -> Bool
$c<= :: IEFlow -> IEFlow -> Bool
< :: IEFlow -> IEFlow -> Bool
$c< :: IEFlow -> IEFlow -> Bool
compare :: IEFlow -> IEFlow -> Ordering
$ccompare :: IEFlow -> IEFlow -> Ordering
Ord, Typeable, (forall x. IEFlow -> Rep IEFlow x)
-> (forall x. Rep IEFlow x -> IEFlow) -> Generic IEFlow
forall x. Rep IEFlow x -> IEFlow
forall x. IEFlow -> Rep IEFlow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IEFlow x -> IEFlow
$cfrom :: forall x. IEFlow -> Rep IEFlow x
Generic, Typeable IEFlow
Typeable IEFlow
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IEFlow -> c IEFlow)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IEFlow)
-> (IEFlow -> Constr)
-> (IEFlow -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IEFlow))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IEFlow))
-> ((forall b. Data b => b -> b) -> IEFlow -> IEFlow)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IEFlow -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IEFlow -> r)
-> (forall u. (forall d. Data d => d -> u) -> IEFlow -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> IEFlow -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IEFlow -> m IEFlow)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IEFlow -> m IEFlow)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IEFlow -> m IEFlow)
-> Data IEFlow
IEFlow -> DataType
IEFlow -> Constr
(forall b. Data b => b -> b) -> IEFlow -> IEFlow
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IEFlow -> u
forall u. (forall d. Data d => d -> u) -> IEFlow -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IEFlow -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IEFlow -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IEFlow -> m IEFlow
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IEFlow -> m IEFlow
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IEFlow
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IEFlow -> c IEFlow
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IEFlow)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IEFlow)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IEFlow -> m IEFlow
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IEFlow -> m IEFlow
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IEFlow -> m IEFlow
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IEFlow -> m IEFlow
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IEFlow -> m IEFlow
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IEFlow -> m IEFlow
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IEFlow -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IEFlow -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> IEFlow -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IEFlow -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IEFlow -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IEFlow -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IEFlow -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IEFlow -> r
gmapT :: (forall b. Data b => b -> b) -> IEFlow -> IEFlow
$cgmapT :: (forall b. Data b => b -> b) -> IEFlow -> IEFlow
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IEFlow)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IEFlow)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IEFlow)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IEFlow)
dataTypeOf :: IEFlow -> DataType
$cdataTypeOf :: IEFlow -> DataType
toConstr :: IEFlow -> Constr
$ctoConstr :: IEFlow -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IEFlow
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IEFlow
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IEFlow -> c IEFlow
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IEFlow -> c IEFlow
Data)
instance NFData IEFlow
ieFlowInsertVar :: Name -> InductionExpr -> IEFlow -> IEFlow
ieFlowInsertVar :: Name -> InductionExpr -> IEFlow -> IEFlow
ieFlowInsertVar Name
v InductionExpr
ie IEFlow
flow = IEFlow
flow { ieFlowVars :: Map Name InductionExpr
ieFlowVars = Name
-> InductionExpr
-> Map Name InductionExpr
-> Map Name InductionExpr
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
v InductionExpr
ie (IEFlow -> Map Name InductionExpr
ieFlowVars IEFlow
flow) }
ieFlowInsertExpr :: ASTExprNode -> InductionExpr -> IEFlow -> IEFlow
ieFlowInsertExpr :: Int -> InductionExpr -> IEFlow -> IEFlow
ieFlowInsertExpr Int
i InductionExpr
ie IEFlow
flow = IEFlow
flow { ieFlowExprs :: DerivedInductionMap
ieFlowExprs = Int -> InductionExpr -> DerivedInductionMap -> DerivedInductionMap
forall a. Int -> a -> IntMap a -> IntMap a
IMS.insert Int
i InductionExpr
ie (IEFlow -> DerivedInductionMap
ieFlowExprs IEFlow
flow) }
emptyIEFlow :: IEFlow
emptyIEFlow :: IEFlow
emptyIEFlow = Map Name InductionExpr -> DerivedInductionMap -> IEFlow
IEFlow Map Name InductionExpr
forall k a. Map k a
M.empty DerivedInductionMap
forall a. IntMap a
IMS.empty
joinIEFlows :: [IEFlow] -> IEFlow
joinIEFlows :: [IEFlow] -> IEFlow
joinIEFlows [IEFlow]
flows = Map Name InductionExpr -> DerivedInductionMap -> IEFlow
IEFlow Map Name InductionExpr
flowV DerivedInductionMap
flowE
where
flowV :: Map Name InductionExpr
flowV = (InductionExpr -> InductionExpr -> InductionExpr)
-> [Map Name InductionExpr] -> Map Name InductionExpr
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith InductionExpr -> InductionExpr -> InductionExpr
joinInductionExprs ((IEFlow -> Map Name InductionExpr)
-> [IEFlow] -> [Map Name InductionExpr]
forall a b. (a -> b) -> [a] -> [b]
map IEFlow -> Map Name InductionExpr
ieFlowVars [IEFlow]
flows)
flowE :: DerivedInductionMap
flowE = (InductionExpr -> InductionExpr -> InductionExpr)
-> [DerivedInductionMap] -> DerivedInductionMap
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IMS.unionsWith InductionExpr -> InductionExpr -> InductionExpr
joinInductionExprs ((IEFlow -> DerivedInductionMap)
-> [IEFlow] -> [DerivedInductionMap]
forall a b. (a -> b) -> [a] -> [b]
map IEFlow -> DerivedInductionMap
ieFlowExprs [IEFlow]
flows)
genDerivedInductionMap :: forall a. Data a => BackEdgeMap -> BBGr (Analysis a) -> DerivedInductionMap
genDerivedInductionMap :: forall a.
Data a =>
IDomMap -> BBGr (Analysis a) -> DerivedInductionMap
genDerivedInductionMap IDomMap
bedges BBGr (Analysis a)
gr = IEFlow -> DerivedInductionMap
ieFlowExprs (IEFlow -> DerivedInductionMap)
-> (InOutMap IEFlow -> IEFlow)
-> InOutMap IEFlow
-> DerivedInductionMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IEFlow] -> IEFlow
joinIEFlows ([IEFlow] -> IEFlow)
-> (InOutMap IEFlow -> [IEFlow]) -> InOutMap IEFlow -> IEFlow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((IEFlow, IEFlow) -> IEFlow) -> [(IEFlow, IEFlow)] -> [IEFlow]
forall a b. (a -> b) -> [a] -> [b]
map (IEFlow, IEFlow) -> IEFlow
forall a b. (a, b) -> b
snd ([(IEFlow, IEFlow)] -> [IEFlow])
-> (InOutMap IEFlow -> [(IEFlow, IEFlow)])
-> InOutMap IEFlow
-> [IEFlow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InOutMap IEFlow -> [(IEFlow, IEFlow)]
forall a. IntMap a -> [a]
IMS.elems (InOutMap IEFlow -> [(IEFlow, IEFlow)])
-> (InOutMap IEFlow -> InOutMap IEFlow)
-> InOutMap IEFlow
-> [(IEFlow, IEFlow)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (IEFlow, IEFlow) -> Bool)
-> InOutMap IEFlow -> InOutMap IEFlow
forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a
IMS.filterWithKey Int -> (IEFlow, IEFlow) -> Bool
forall {p}. Int -> p -> Bool
inLoop (InOutMap IEFlow -> DerivedInductionMap)
-> InOutMap IEFlow -> DerivedInductionMap
forall a b. (a -> b) -> a -> b
$ InOutMap IEFlow
inOutMaps
where
bivMap :: InductionVarMap
bivMap = IDomMap -> BBGr (Analysis a) -> InductionVarMap
forall a. Data a => IDomMap -> BBGr (Analysis a) -> InductionVarMap
basicInductionVars IDomMap
bedges BBGr (Analysis a)
gr
loopNodeSet :: BBNodeSet
loopNodeSet = [BBNodeSet] -> BBNodeSet
forall (f :: * -> *). Foldable f => f BBNodeSet -> BBNodeSet
IS.unions (IDomMap -> Gr (BB (Analysis a)) () -> [BBNodeSet]
forall (gr :: * -> * -> *) a b.
Graph gr =>
IDomMap -> gr a b -> [BBNodeSet]
loopNodes IDomMap
bedges (Gr (BB (Analysis a)) () -> [BBNodeSet])
-> Gr (BB (Analysis a)) () -> [BBNodeSet]
forall a b. (a -> b) -> a -> b
$ BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr)
inLoop :: Int -> p -> Bool
inLoop Int
i p
_ = Int
i Int -> BBNodeSet -> Bool
`IS.member` BBNodeSet
loopNodeSet
step :: IEFlow -> Block (Analysis a) -> IEFlow
step :: IEFlow -> Block (Analysis a) -> IEFlow
step !IEFlow
flow Block (Analysis a)
b = case Block (Analysis a)
b of
BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ (StExpressionAssign Analysis a
_ SrcSpan
_ lv :: Expression (Analysis a)
lv@(ExpValue Analysis a
_ SrcSpan
_ (ValVariable Name
_)) Expression (Analysis a)
rhs)
| Maybe Int
_ <- Analysis a -> Maybe Int
forall a. Analysis a -> Maybe Int
insLabel (Expression (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
rhs), IEFlow
flow'' <- Name -> InductionExpr -> IEFlow -> IEFlow
ieFlowInsertVar (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
lv) (IEFlow -> Expression (Analysis a) -> InductionExpr
forall a.
Data a =>
IEFlow -> Expression (Analysis a) -> InductionExpr
derivedInductionExprMemo IEFlow
flow' Expression (Analysis a)
rhs) IEFlow
flow'
-> IEFlow -> Expression (Analysis a) -> IEFlow
stepExpr IEFlow
flow'' Expression (Analysis a)
lv
Block (Analysis a)
_ -> IEFlow
flow'
where
flow' :: IEFlow
flow' = State IEFlow (Block (Analysis a)) -> IEFlow -> IEFlow
forall s a. State s a -> s -> s
execState ((Expression (Analysis a) -> State IEFlow (Expression (Analysis a)))
-> Block (Analysis a) -> State IEFlow (Block (Analysis a))
trans (\ Expression (Analysis a)
e -> Expression (Analysis a) -> State IEFlow InductionExpr
forall a.
Data a =>
Expression (Analysis a) -> State IEFlow InductionExpr
derivedInductionExprM Expression (Analysis a)
e State IEFlow InductionExpr
-> State IEFlow (Expression (Analysis a))
-> State IEFlow (Expression (Analysis a))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expression (Analysis a) -> State IEFlow (Expression (Analysis a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression (Analysis a)
e) Block (Analysis a)
b) IEFlow
flow
trans :: (Expression (Analysis a) -> State IEFlow (Expression (Analysis a)))
-> Block (Analysis a) -> State IEFlow (Block (Analysis a))
trans = (Expression (Analysis a) -> State IEFlow (Expression (Analysis a)))
-> Block (Analysis a) -> State IEFlow (Block (Analysis a))
forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM :: (Expression (Analysis a) -> State IEFlow (Expression (Analysis a))) -> Block (Analysis a) -> State IEFlow (Block (Analysis a))
stepExpr :: IEFlow -> Expression (Analysis a) -> IEFlow
stepExpr :: IEFlow -> Expression (Analysis a) -> IEFlow
stepExpr !IEFlow
flow Expression (Analysis a)
e = Int -> InductionExpr -> IEFlow -> IEFlow
ieFlowInsertExpr Int
label InductionExpr
ie IEFlow
flow
where
ie :: InductionExpr
ie = IEFlow -> Expression (Analysis a) -> InductionExpr
forall a.
Data a =>
IEFlow -> Expression (Analysis a) -> InductionExpr
derivedInductionExpr IEFlow
flow Expression (Analysis a)
e
label :: Int
label = Name -> Maybe Int -> Int
forall a. Name -> Maybe a -> a
fromJustMsg Name
"stepExpr" (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Analysis a -> Maybe Int
forall a. Analysis a -> Maybe Int
insLabel (Expression (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
e)
out :: InF IEFlow -> OutF IEFlow
out :: InF IEFlow -> InF IEFlow
out InF IEFlow
inF Int
node = IEFlow
flow'
where
flow :: IEFlow
flow = [IEFlow] -> IEFlow
joinIEFlows [(IEFlow, IEFlow) -> IEFlow
forall a b. (a, b) -> a
fst (Int -> (IEFlow, IEFlow)
initF Int
node), InF IEFlow
inF Int
node]
flow' :: IEFlow
flow' = (IEFlow -> Block (Analysis a) -> IEFlow)
-> IEFlow -> BB (Analysis a) -> IEFlow
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IEFlow -> Block (Analysis a) -> IEFlow
step IEFlow
flow (Name -> Maybe (BB (Analysis a)) -> BB (Analysis a)
forall a. Name -> Maybe a -> a
fromJustMsg (Name
"analyseDerivedIE out(" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Int -> Name
forall a. Show a => a -> Name
show Int
node Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
")") (Maybe (BB (Analysis a)) -> BB (Analysis a))
-> Maybe (BB (Analysis a)) -> BB (Analysis a)
forall a b. (a -> b) -> a -> b
$ Gr (BB (Analysis a)) () -> Int -> Maybe (BB (Analysis a))
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
node)
inn :: OutF IEFlow -> InF IEFlow
inn :: InF IEFlow -> InF IEFlow
inn InF IEFlow
outF Int
node = [IEFlow] -> IEFlow
joinIEFlows [ InF IEFlow
outF Int
p | Int
p <- Gr (BB (Analysis a)) () -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
pre (BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
node ]
initF :: Node -> InOut IEFlow
initF :: Int -> (IEFlow, IEFlow)
initF Int
node = case Int -> InductionVarMap -> Maybe (Set Name)
forall a. Int -> IntMap a -> Maybe a
IMS.lookup Int
node InductionVarMap
bivMap of
Just Set Name
set -> (Map Name InductionExpr -> DerivedInductionMap -> IEFlow
IEFlow ([(Name, InductionExpr)] -> Map Name InductionExpr
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Name
n, Name -> Int -> Int -> InductionExpr
IELinear Name
n Int
1 Int
0) | Name
n <- Set Name -> [Name]
forall a. Set a -> [a]
S.toList Set Name
set ]) DerivedInductionMap
forall a. IntMap a
IMS.empty, IEFlow
emptyIEFlow)
Maybe (Set Name)
Nothing -> (IEFlow
emptyIEFlow, IEFlow
emptyIEFlow)
inOutMaps :: InOutMap IEFlow
inOutMaps = BBGr (Analysis a)
-> (Int -> (IEFlow, IEFlow))
-> OrderF (Analysis a)
-> (InF IEFlow -> InF IEFlow)
-> (InF IEFlow -> InF IEFlow)
-> InOutMap IEFlow
forall t a.
(NFData t, Ord t) =>
BBGr a
-> (Int -> InOut t)
-> OrderF a
-> (OutF t -> OutF t)
-> (OutF t -> OutF t)
-> InOutMap t
dataFlowSolver BBGr (Analysis a)
gr Int -> (IEFlow, IEFlow)
initF OrderF (Analysis a)
forall a. OrderF a
revPostOrder InF IEFlow -> InF IEFlow
inn InF IEFlow -> InF IEFlow
out
derivedInductionExprMemo :: Data a => IEFlow -> Expression (Analysis a) -> InductionExpr
derivedInductionExprMemo :: forall a.
Data a =>
IEFlow -> Expression (Analysis a) -> InductionExpr
derivedInductionExprMemo IEFlow
flow Expression (Analysis a)
e
| Just Int
label <- Analysis a -> Maybe Int
forall a. Analysis a -> Maybe Int
insLabel (Expression (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
e)
, Just InductionExpr
iexpr <- Int -> DerivedInductionMap -> Maybe InductionExpr
forall a. Int -> IntMap a -> Maybe a
IMS.lookup Int
label (IEFlow -> DerivedInductionMap
ieFlowExprs IEFlow
flow) = InductionExpr
iexpr
| Bool
otherwise = IEFlow -> Expression (Analysis a) -> InductionExpr
forall a.
Data a =>
IEFlow -> Expression (Analysis a) -> InductionExpr
derivedInductionExpr IEFlow
flow Expression (Analysis a)
e
derivedInductionExpr :: Data a => IEFlow -> Expression (Analysis a) -> InductionExpr
derivedInductionExpr :: forall a.
Data a =>
IEFlow -> Expression (Analysis a) -> InductionExpr
derivedInductionExpr IEFlow
flow Expression (Analysis a)
e = case Expression (Analysis a)
e of
v :: Expression (Analysis a)
v@(ExpValue Analysis a
_ SrcSpan
_ (ValVariable Name
_)) -> InductionExpr -> Maybe InductionExpr -> InductionExpr
forall a. a -> Maybe a -> a
fromMaybe InductionExpr
IETop (Maybe InductionExpr -> InductionExpr)
-> Maybe InductionExpr -> InductionExpr
forall a b. (a -> b) -> a -> b
$ Name -> Map Name InductionExpr -> Maybe InductionExpr
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v) (IEFlow -> Map Name InductionExpr
ieFlowVars IEFlow
flow)
ExpValue Analysis a
_ SrcSpan
_ (ValInteger Name
intStr Maybe (KindParam (Analysis a))
_) -> Name -> Int -> Int -> InductionExpr
IELinear Name
"" Int
0 (Int -> InductionExpr) -> Int -> InductionExpr
forall a b. (a -> b) -> a -> b
$ Name -> Int
forall a. Read a => Name -> a
read Name
intStr
ExpBinary Analysis a
_ SrcSpan
_ BinaryOp
Addition Expression (Analysis a)
e1 Expression (Analysis a)
e2 -> Expression (Analysis a) -> InductionExpr
derive Expression (Analysis a)
e1 InductionExpr -> InductionExpr -> InductionExpr
`addInductionExprs` Expression (Analysis a) -> InductionExpr
derive Expression (Analysis a)
e2
ExpBinary Analysis a
_ SrcSpan
_ BinaryOp
Subtraction Expression (Analysis a)
e1 Expression (Analysis a)
e2 -> Expression (Analysis a) -> InductionExpr
derive Expression (Analysis a)
e1 InductionExpr -> InductionExpr -> InductionExpr
`addInductionExprs` InductionExpr -> InductionExpr
negInductionExpr (Expression (Analysis a) -> InductionExpr
derive Expression (Analysis a)
e2)
ExpBinary Analysis a
_ SrcSpan
_ BinaryOp
Multiplication Expression (Analysis a)
e1 Expression (Analysis a)
e2 -> Expression (Analysis a) -> InductionExpr
derive Expression (Analysis a)
e1 InductionExpr -> InductionExpr -> InductionExpr
`mulInductionExprs` Expression (Analysis a) -> InductionExpr
derive Expression (Analysis a)
e2
Expression (Analysis a)
_ -> InductionExpr
IETop
where
derive :: Expression (Analysis a) -> InductionExpr
derive = IEFlow -> Expression (Analysis a) -> InductionExpr
forall a.
Data a =>
IEFlow -> Expression (Analysis a) -> InductionExpr
derivedInductionExpr IEFlow
flow
derivedInductionExprM :: Data a => Expression (Analysis a) -> State IEFlow InductionExpr
derivedInductionExprM :: forall a.
Data a =>
Expression (Analysis a) -> State IEFlow InductionExpr
derivedInductionExprM Expression (Analysis a)
e = do
IEFlow
flow <- StateT IEFlow Identity IEFlow
forall s (m :: * -> *). MonadState s m => m s
get
let derive :: Expression (Analysis a) -> State IEFlow InductionExpr
derive Expression (Analysis a)
e' | Just Int
label <- Analysis a -> Maybe Int
forall a. Analysis a -> Maybe Int
insLabel (Expression (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
e')
, Just InductionExpr
iexpr <- Int -> DerivedInductionMap -> Maybe InductionExpr
forall a. Int -> IntMap a -> Maybe a
IMS.lookup Int
label (IEFlow -> DerivedInductionMap
ieFlowExprs IEFlow
flow) = InductionExpr -> State IEFlow InductionExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure InductionExpr
iexpr
| Bool
otherwise = Expression (Analysis a) -> State IEFlow InductionExpr
forall a.
Data a =>
Expression (Analysis a) -> State IEFlow InductionExpr
derivedInductionExprM Expression (Analysis a)
e'
InductionExpr
ie <- case Expression (Analysis a)
e of
v :: Expression (Analysis a)
v@(ExpValue Analysis a
_ SrcSpan
_ (ValVariable Name
_)) -> InductionExpr -> State IEFlow InductionExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InductionExpr -> State IEFlow InductionExpr)
-> (Maybe InductionExpr -> InductionExpr)
-> Maybe InductionExpr
-> State IEFlow InductionExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InductionExpr -> Maybe InductionExpr -> InductionExpr
forall a. a -> Maybe a -> a
fromMaybe InductionExpr
IETop (Maybe InductionExpr -> State IEFlow InductionExpr)
-> Maybe InductionExpr -> State IEFlow InductionExpr
forall a b. (a -> b) -> a -> b
$ Name -> Map Name InductionExpr -> Maybe InductionExpr
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v) (IEFlow -> Map Name InductionExpr
ieFlowVars IEFlow
flow)
ExpValue Analysis a
_ SrcSpan
_ (ValInteger Name
intStr Maybe (KindParam (Analysis a))
_) -> InductionExpr -> State IEFlow InductionExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InductionExpr -> State IEFlow InductionExpr)
-> InductionExpr -> State IEFlow InductionExpr
forall a b. (a -> b) -> a -> b
$ Name -> Int -> Int -> InductionExpr
IELinear Name
"" Int
0 (Int -> InductionExpr) -> Int -> InductionExpr
forall a b. (a -> b) -> a -> b
$ Name -> Int
forall a. Read a => Name -> a
read Name
intStr
ExpBinary Analysis a
_ SrcSpan
_ BinaryOp
Addition Expression (Analysis a)
e1 Expression (Analysis a)
e2 -> InductionExpr -> InductionExpr -> InductionExpr
addInductionExprs (InductionExpr -> InductionExpr -> InductionExpr)
-> State IEFlow InductionExpr
-> StateT IEFlow Identity (InductionExpr -> InductionExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression (Analysis a) -> State IEFlow InductionExpr
forall a.
Data a =>
Expression (Analysis a) -> State IEFlow InductionExpr
derive Expression (Analysis a)
e1 StateT IEFlow Identity (InductionExpr -> InductionExpr)
-> State IEFlow InductionExpr -> State IEFlow InductionExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression (Analysis a) -> State IEFlow InductionExpr
forall a.
Data a =>
Expression (Analysis a) -> State IEFlow InductionExpr
derive Expression (Analysis a)
e2
ExpBinary Analysis a
_ SrcSpan
_ BinaryOp
Subtraction Expression (Analysis a)
e1 Expression (Analysis a)
e2 -> InductionExpr -> InductionExpr -> InductionExpr
addInductionExprs (InductionExpr -> InductionExpr -> InductionExpr)
-> State IEFlow InductionExpr
-> StateT IEFlow Identity (InductionExpr -> InductionExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression (Analysis a) -> State IEFlow InductionExpr
forall a.
Data a =>
Expression (Analysis a) -> State IEFlow InductionExpr
derive Expression (Analysis a)
e1 StateT IEFlow Identity (InductionExpr -> InductionExpr)
-> State IEFlow InductionExpr -> State IEFlow InductionExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (InductionExpr -> InductionExpr
negInductionExpr (InductionExpr -> InductionExpr)
-> State IEFlow InductionExpr -> State IEFlow InductionExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression (Analysis a) -> State IEFlow InductionExpr
forall a.
Data a =>
Expression (Analysis a) -> State IEFlow InductionExpr
derive Expression (Analysis a)
e2)
ExpBinary Analysis a
_ SrcSpan
_ BinaryOp
Multiplication Expression (Analysis a)
e1 Expression (Analysis a)
e2 -> InductionExpr -> InductionExpr -> InductionExpr
mulInductionExprs (InductionExpr -> InductionExpr -> InductionExpr)
-> State IEFlow InductionExpr
-> StateT IEFlow Identity (InductionExpr -> InductionExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression (Analysis a) -> State IEFlow InductionExpr
forall a.
Data a =>
Expression (Analysis a) -> State IEFlow InductionExpr
derive Expression (Analysis a)
e1 StateT IEFlow Identity (InductionExpr -> InductionExpr)
-> State IEFlow InductionExpr -> State IEFlow InductionExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression (Analysis a) -> State IEFlow InductionExpr
forall a.
Data a =>
Expression (Analysis a) -> State IEFlow InductionExpr
derive Expression (Analysis a)
e2
Expression (Analysis a)
_ -> InductionExpr -> State IEFlow InductionExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InductionExpr -> State IEFlow InductionExpr)
-> InductionExpr -> State IEFlow InductionExpr
forall a b. (a -> b) -> a -> b
$ InductionExpr
IETop
let Just Int
label = Analysis a -> Maybe Int
forall a. Analysis a -> Maybe Int
insLabel (Expression (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
e)
IEFlow -> StateT IEFlow Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IEFlow -> StateT IEFlow Identity ())
-> IEFlow -> StateT IEFlow Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> InductionExpr -> IEFlow -> IEFlow
ieFlowInsertExpr Int
label InductionExpr
ie IEFlow
flow
InductionExpr -> State IEFlow InductionExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure InductionExpr
ie
addInductionExprs :: InductionExpr -> InductionExpr -> InductionExpr
addInductionExprs :: InductionExpr -> InductionExpr -> InductionExpr
addInductionExprs (IELinear Name
ln Int
lc Int
lo) (IELinear Name
rn Int
rc Int
ro)
| Name
ln Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
rn = Name -> Int -> Int -> InductionExpr
IELinear Name
ln (Int
lc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rc) (Int
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ro)
| Int
lc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Name -> Int -> Int -> InductionExpr
IELinear Name
rn Int
rc (Int
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ro)
| Int
rc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Name -> Int -> Int -> InductionExpr
IELinear Name
ln Int
lc (Int
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ro)
| Bool
otherwise = InductionExpr
IEBottom
addInductionExprs InductionExpr
_ InductionExpr
IETop = InductionExpr
IETop
addInductionExprs InductionExpr
IETop InductionExpr
_ = InductionExpr
IETop
addInductionExprs InductionExpr
_ InductionExpr
_ = InductionExpr
IEBottom
negInductionExpr :: InductionExpr -> InductionExpr
negInductionExpr :: InductionExpr -> InductionExpr
negInductionExpr (IELinear Name
n Int
c Int
o) = Name -> Int -> Int -> InductionExpr
IELinear Name
n (-Int
c) (-Int
o)
negInductionExpr InductionExpr
IETop = InductionExpr
IETop
negInductionExpr InductionExpr
_ = InductionExpr
IEBottom
mulInductionExprs :: InductionExpr -> InductionExpr -> InductionExpr
mulInductionExprs :: InductionExpr -> InductionExpr -> InductionExpr
mulInductionExprs (IELinear Name
"" Int
_ Int
lo) (IELinear Name
rn Int
rc Int
ro) = Name -> Int -> Int -> InductionExpr
IELinear Name
rn (Int
rc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
lo) (Int
ro Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
lo)
mulInductionExprs (IELinear Name
ln Int
lc Int
lo) (IELinear Name
"" Int
_ Int
ro) = Name -> Int -> Int -> InductionExpr
IELinear Name
ln (Int
lc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ro) (Int
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ro)
mulInductionExprs InductionExpr
_ InductionExpr
IETop = InductionExpr
IETop
mulInductionExprs InductionExpr
IETop InductionExpr
_ = InductionExpr
IETop
mulInductionExprs InductionExpr
_ InductionExpr
_ = InductionExpr
IEBottom
joinInductionExprs :: InductionExpr -> InductionExpr -> InductionExpr
joinInductionExprs :: InductionExpr -> InductionExpr -> InductionExpr
joinInductionExprs InductionExpr
ie1 InductionExpr
IETop = InductionExpr
ie1
joinInductionExprs InductionExpr
IETop InductionExpr
ie2 = InductionExpr
ie2
joinInductionExprs InductionExpr
ie1 InductionExpr
ie2
| InductionExpr
ie1 InductionExpr -> InductionExpr -> Bool
forall a. Eq a => a -> a -> Bool
== InductionExpr
ie2 = InductionExpr
ie1
| Bool
otherwise = InductionExpr
IEBottom
showDataFlow :: (Data a, Out a, Show a) => ProgramFile (Analysis a) -> String
showDataFlow :: forall a.
(Data a, Out a, Show a) =>
ProgramFile (Analysis a) -> Name
showDataFlow ProgramFile (Analysis a)
pf = ProgramUnit (Analysis a) -> Name
perPU (ProgramUnit (Analysis a) -> Name)
-> [ProgramUnit (Analysis a)] -> Name
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
uni ProgramFile (Analysis a)
pf
where
uni :: ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
uni = forall {a}.
Data a =>
ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi :: Data a => ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
perPU :: ProgramUnit (Analysis a) -> Name
perPU ProgramUnit (Analysis a)
pu | Analysis { bBlocks :: forall a. Analysis a -> Maybe (BBGr (Analysis a))
bBlocks = Just BBGr (Analysis a)
gr } <- ProgramUnit (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation ProgramUnit (Analysis a)
pu =
Name
dashes Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"\n" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
p Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"\n" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
dashes Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"\n" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ BBGr (Analysis a) -> Name
dfStr BBGr (Analysis a)
gr Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"\n\n"
where p :: Name
p = Name
"| Program Unit " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ ProgramUnitName -> Name
forall a. Show a => a -> Name
show (ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
puName ProgramUnit (Analysis a)
pu) Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" |"
dashes :: Name
dashes = Int -> Char -> Name
forall a. Int -> a -> [a]
replicate (Name -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Name
p) Char
'-'
dfStr :: BBGr (Analysis a) -> Name
dfStr BBGr (Analysis a)
gr = (\ (Name
l, Name
x) -> Char
'\n'Char -> Name -> Name
forall a. a -> [a] -> [a]
:Name
l Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
": " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
x) ((Name, Name) -> Name) -> [(Name, Name)] -> Name
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [
(Name
"callMap", CallMap -> Name
forall a. Show a => a -> Name
show CallMap
cm)
, (Name
"postOrder", [Int] -> Name
forall a. Show a => a -> Name
show (OrderF (Analysis a)
forall a. OrderF a
postOrder BBGr (Analysis a)
gr))
, (Name
"revPostOrder", [Int] -> Name
forall a. Show a => a -> Name
show (OrderF (Analysis a)
forall a. OrderF a
revPostOrder BBGr (Analysis a)
gr))
, (Name
"revPreOrder", [Int] -> Name
forall a. Show a => a -> Name
show (OrderF (Analysis a)
forall a. OrderF a
revPreOrder BBGr (Analysis a)
gr))
, (Name
"dominators", DomMap -> Name
forall a. Show a => a -> Name
show (BBGr (Analysis a) -> DomMap
forall a. BBGr a -> DomMap
dominators BBGr (Analysis a)
gr))
, (Name
"iDominators", IDomMap -> Name
forall a. Show a => a -> Name
show (BBGr (Analysis a) -> IDomMap
forall a. BBGr a -> IDomMap
iDominators BBGr (Analysis a)
gr))
, (Name
"defMap", DefMap -> Name
forall a. Show a => a -> Name
show DefMap
dm)
, (Name
"lva", [(Int, InOut (Set Name))] -> Name
forall a. Show a => a -> Name
show (InOutMap (Set Name) -> [(Int, InOut (Set Name))]
forall a. IntMap a -> [(Int, a)]
IM.toList (InOutMap (Set Name) -> [(Int, InOut (Set Name))])
-> InOutMap (Set Name) -> [(Int, InOut (Set Name))]
forall a b. (a -> b) -> a -> b
$ BBGr (Analysis a) -> InOutMap (Set Name)
lva BBGr (Analysis a)
gr))
, (Name
"rd", [(Int, (BBNodeSet, BBNodeSet))] -> Name
forall a. Show a => a -> Name
show (IntMap (BBNodeSet, BBNodeSet) -> [(Int, (BBNodeSet, BBNodeSet))]
forall a. IntMap a -> [(Int, a)]
IM.toList (IntMap (BBNodeSet, BBNodeSet) -> [(Int, (BBNodeSet, BBNodeSet))])
-> IntMap (BBNodeSet, BBNodeSet) -> [(Int, (BBNodeSet, BBNodeSet))]
forall a b. (a -> b) -> a -> b
$ BBGr (Analysis a) -> IntMap (BBNodeSet, BBNodeSet)
rd BBGr (Analysis a)
gr))
, (Name
"backEdges", IDomMap -> Name
forall a. Show a => a -> Name
show IDomMap
bedges)
, (Name
"topsort", [Int] -> Name
forall a. Show a => a -> Name
show (Gr (BB (Analysis a)) () -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Int]
topsort (Gr (BB (Analysis a)) () -> [Int])
-> Gr (BB (Analysis a)) () -> [Int]
forall a b. (a -> b) -> a -> b
$ BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr))
, (Name
"scc ", [[Int]] -> Name
forall a. Show a => a -> Name
show (Gr (BB (Analysis a)) () -> [[Int]]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Int]]
scc (Gr (BB (Analysis a)) () -> [[Int]])
-> Gr (BB (Analysis a)) () -> [[Int]]
forall a b. (a -> b) -> a -> b
$ BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr))
, (Name
"loopNodes", [BBNodeSet] -> Name
forall a. Show a => a -> Name
show (IDomMap -> Gr (BB (Analysis a)) () -> [BBNodeSet]
forall (gr :: * -> * -> *) a b.
Graph gr =>
IDomMap -> gr a b -> [BBNodeSet]
loopNodes IDomMap
bedges (Gr (BB (Analysis a)) () -> [BBNodeSet])
-> Gr (BB (Analysis a)) () -> [BBNodeSet]
forall a b. (a -> b) -> a -> b
$ BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr))
, (Name
"duMap", DomMap -> Name
forall a. Show a => a -> Name
show (BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> DomMap
forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> DomMap
genDUMap BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr (BBGr (Analysis a) -> IntMap (BBNodeSet, BBNodeSet)
rd BBGr (Analysis a)
gr)))
, (Name
"udMap", DomMap -> Name
forall a. Show a => a -> Name
show (BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> DomMap
forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> DomMap
genUDMap BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr (BBGr (Analysis a) -> IntMap (BBNodeSet, BBNodeSet)
rd BBGr (Analysis a)
gr)))
, (Name
"flowsTo", [(Int, Int)] -> Name
forall a. Show a => a -> Name
show (Gr (Block (Analysis a)) () -> [(Int, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [(Int, Int)]
edges Gr (Block (Analysis a)) ()
flTo))
, (Name
"varFlowsTo", VarFlowsMap -> Name
forall a. Show a => a -> Name
show (DefMap -> Gr (Block (Analysis a)) () -> VarFlowsMap
forall a. Data a => DefMap -> FlowsGraph a -> VarFlowsMap
genVarFlowsToMap DefMap
dm (BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> Gr (Block (Analysis a)) ()
forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> FlowsGraph a
genFlowsToGraph BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr (BBGr (Analysis a) -> IntMap (BBNodeSet, BBNodeSet)
rd BBGr (Analysis a)
gr))))
, (Name
"ivMap", InductionVarMap -> Name
forall a. Show a => a -> Name
show (IDomMap -> BBGr (Analysis a) -> InductionVarMap
forall a. Data a => IDomMap -> BBGr (Analysis a) -> InductionVarMap
genInductionVarMap IDomMap
bedges BBGr (Analysis a)
gr))
, (Name
"ivMapByAST", InductionVarMap -> Name
forall a. Show a => a -> Name
show (IDomMap -> BBGr (Analysis a) -> InductionVarMap
forall a. Data a => IDomMap -> BBGr (Analysis a) -> InductionVarMap
genInductionVarMapByASTBlock IDomMap
bedges BBGr (Analysis a)
gr))
, (Name
"constExpMap", ConstExpMap -> Name
forall a. Show a => a -> Name
show (ProgramFile (Analysis a) -> ConstExpMap
forall a. Data a => ProgramFile (Analysis a) -> ConstExpMap
genConstExpMap ProgramFile (Analysis a)
pf))
, (Name
"entries", [Int] -> Name
forall a. Show a => a -> Name
show (OrderF (Analysis a)
forall a. OrderF a
bbgrEntries BBGr (Analysis a)
gr))
, (Name
"exits", [Int] -> Name
forall a. Show a => a -> Name
show (OrderF (Analysis a)
forall a. OrderF a
bbgrExits BBGr (Analysis a)
gr))
] where
bedges :: IDomMap
bedges = DomMap -> Gr (BB (Analysis a)) () -> IDomMap
forall (gr :: * -> * -> *) a b.
Graph gr =>
DomMap -> gr a b -> IDomMap
genBackEdgeMap (BBGr (Analysis a) -> DomMap
forall a. BBGr a -> DomMap
dominators BBGr (Analysis a)
gr) (Gr (BB (Analysis a)) () -> IDomMap)
-> Gr (BB (Analysis a)) () -> IDomMap
forall a b. (a -> b) -> a -> b
$ BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr
flTo :: Gr (Block (Analysis a)) ()
flTo = BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> Gr (Block (Analysis a)) ()
forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> FlowsGraph a
genFlowsToGraph BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr (BBGr (Analysis a) -> IntMap (BBNodeSet, BBNodeSet)
rd BBGr (Analysis a)
gr)
perPU ProgramUnit (Analysis a)
pu = Name
dashes Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"\n" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
p Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"\n" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
dashes Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"\n" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
dfStr Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"\n\n"
where p :: Name
p = Name
"| Program Unit " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ ProgramUnitName -> Name
forall a. Show a => a -> Name
show (ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
puName ProgramUnit (Analysis a)
pu) Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" |"
dashes :: Name
dashes = Int -> Char -> Name
forall a. Int -> a -> [a]
replicate (Name -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Name
p) Char
'-'
dfStr :: Name
dfStr = (\ (Name
l, Name
x) -> Char
'\n'Char -> Name -> Name
forall a. a -> [a] -> [a]
:Name
l Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
": " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
x) ((Name, Name) -> Name) -> [(Name, Name)] -> Name
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [
(Name
"constExpMap", ConstExpMap -> Name
forall a. Show a => a -> Name
show (ProgramFile (Analysis a) -> ConstExpMap
forall a. Data a => ProgramFile (Analysis a) -> ConstExpMap
genConstExpMap ProgramFile (Analysis a)
pf))
]
lva :: BBGr (Analysis a) -> InOutMap (Set Name)
lva = BBGr (Analysis a) -> InOutMap (Set Name)
forall a. Data a => BBGr (Analysis a) -> InOutMap (Set Name)
liveVariableAnalysis
bm :: BlockMap a
bm = ProgramFile (Analysis a) -> BlockMap a
forall a. Data a => ProgramFile (Analysis a) -> BlockMap a
genBlockMap ProgramFile (Analysis a)
pf
dm :: DefMap
dm = BlockMap a -> DefMap
forall a. Data a => BlockMap a -> DefMap
genDefMap BlockMap a
bm
rd :: BBGr (Analysis a) -> IntMap (BBNodeSet, BBNodeSet)
rd = DefMap -> BBGr (Analysis a) -> IntMap (BBNodeSet, BBNodeSet)
forall a.
Data a =>
DefMap -> BBGr (Analysis a) -> IntMap (BBNodeSet, BBNodeSet)
reachingDefinitions DefMap
dm
cm :: CallMap
cm = ProgramFile (Analysis a) -> CallMap
forall a. Data a => ProgramFile (Analysis a) -> CallMap
genCallMap ProgramFile (Analysis a)
pf
showFlowsDOT :: (Data a, Out a, Show a) => ProgramFile (Analysis a) -> BBGr (Analysis a) -> ASTBlockNode -> Bool -> String
showFlowsDOT :: forall a.
(Data a, Out a, Show a) =>
ProgramFile (Analysis a)
-> BBGr (Analysis a) -> Int -> Bool -> Name
showFlowsDOT ProgramFile (Analysis a)
pf BBGr (Analysis a)
bbgr Int
astBlockId Bool
isFrom = Writer Name () -> Name
forall w a. Writer w a -> w
execWriter (Writer Name () -> Name) -> Writer Name () -> Name
forall a b. (a -> b) -> a -> b
$ do
let bm :: BlockMap a
bm = ProgramFile (Analysis a) -> BlockMap a
forall a. Data a => ProgramFile (Analysis a) -> BlockMap a
genBlockMap ProgramFile (Analysis a)
pf
dm :: DefMap
dm = BlockMap a -> DefMap
forall a. Data a => BlockMap a -> DefMap
genDefMap BlockMap a
bm
flowsTo :: FlowsGraph a
flowsTo = BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> FlowsGraph a
forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> IntMap (BBNodeSet, BBNodeSet)
-> FlowsGraph a
genFlowsToGraph BlockMap a
bm DefMap
dm BBGr (Analysis a)
bbgr (DefMap -> BBGr (Analysis a) -> IntMap (BBNodeSet, BBNodeSet)
forall a.
Data a =>
DefMap -> BBGr (Analysis a) -> IntMap (BBNodeSet, BBNodeSet)
reachingDefinitions DefMap
dm BBGr (Analysis a)
bbgr)
flows :: FlowsGraph a
flows | Bool
isFrom = FlowsGraph a -> FlowsGraph a
forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> gr a b
grev FlowsGraph a
flowsTo
| Bool
otherwise = FlowsGraph a
flowsTo
Name -> Writer Name ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Name
"strict digraph {\n"
[Int] -> (Int -> Writer Name ()) -> Writer Name ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> FlowsGraph a -> [Int]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> [Int]
bfsn [Int
astBlockId] FlowsGraph a
flows) ((Int -> Writer Name ()) -> Writer Name ())
-> (Int -> Writer Name ()) -> Writer Name ()
forall a b. (a -> b) -> a -> b
$ \ Int
n -> do
let pseudocode :: Name
pseudocode = Name
-> (Block (Analysis a) -> Name)
-> Maybe (Block (Analysis a))
-> Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Name
"<N/A>" Block (Analysis a) -> Name
forall a. Block a -> Name
showBlock (Maybe (Block (Analysis a)) -> Name)
-> Maybe (Block (Analysis a)) -> Name
forall a b. (a -> b) -> a -> b
$ Int -> BlockMap a -> Maybe (Block (Analysis a))
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
n BlockMap a
bm
Name -> Writer Name ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Name
"node [shape=box,fontname=\"Courier New\"]\n"
Name -> Writer Name ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Name -> Writer Name ()) -> Name -> Writer Name ()
forall a b. (a -> b) -> a -> b
$ Name
"Bl" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Int -> Name
forall a. Show a => a -> Name
show Int
n Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"[label=\"B" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Int -> Name
forall a. Show a => a -> Name
show Int
n Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"\\l" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
pseudocode Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"\"]\n"
Name -> Writer Name ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Name -> Writer Name ()) -> Name -> Writer Name ()
forall a b. (a -> b) -> a -> b
$ Name
"Bl" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Int -> Name
forall a. Show a => a -> Name
show Int
n Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" -> {"
[Int] -> (Int -> Writer Name ()) -> Writer Name ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (FlowsGraph a -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
suc FlowsGraph a
flows Int
n) ((Int -> Writer Name ()) -> Writer Name ())
-> (Int -> Writer Name ()) -> Writer Name ()
forall a b. (a -> b) -> a -> b
$ \ Int
m -> Name -> Writer Name ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Name
" Bl" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Int -> Name
forall a. Show a => a -> Name
show Int
m)
Name -> Writer Name ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Name
"}\n"
Name -> Writer Name ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Name
"}\n"
type CallMap = M.Map ProgramUnitName (S.Set Name)
genCallMap :: Data a => ProgramFile (Analysis a) -> CallMap
genCallMap :: forall a. Data a => ProgramFile (Analysis a) -> CallMap
genCallMap ProgramFile (Analysis a)
pf = (State CallMap () -> CallMap -> CallMap)
-> CallMap -> State CallMap () -> CallMap
forall a b c. (a -> b -> c) -> b -> a -> c
flip State CallMap () -> CallMap -> CallMap
forall s a. State s a -> s -> s
Lazy.execState CallMap
forall k a. Map k a
M.empty (State CallMap () -> CallMap) -> State CallMap () -> CallMap
forall a b. (a -> b) -> a -> b
$ do
let uP :: ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
uP = forall {a}. Data a => ProgramFile a -> [ProgramUnit a]
forall from to. Biplate from to => from -> [to]
universeBi :: Data a => ProgramFile a -> [ProgramUnit a]
[ProgramUnit (Analysis a)]
-> (ProgramUnit (Analysis a) -> State CallMap ())
-> State CallMap ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
uP ProgramFile (Analysis a)
pf) ((ProgramUnit (Analysis a) -> State CallMap ())
-> State CallMap ())
-> (ProgramUnit (Analysis a) -> State CallMap ())
-> State CallMap ()
forall a b. (a -> b) -> a -> b
$ \ ProgramUnit (Analysis a)
pu -> do
let n :: ProgramUnitName
n = ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
puName ProgramUnit (Analysis a)
pu
let uS :: Data a => ProgramUnit a -> [Statement a]
uS :: forall a. Data a => ProgramUnit a -> [Statement a]
uS = ProgramUnit a -> [Statement a]
forall from to. Biplate from to => from -> [to]
universeBi
let uE :: Data a => ProgramUnit a -> [Expression a]
uE :: forall a. Data a => ProgramUnit a -> [Expression a]
uE = ProgramUnit a -> [Expression a]
forall from to. Biplate from to => from -> [to]
universeBi
CallMap
m <- StateT CallMap Identity CallMap
forall s (m :: * -> *). MonadState s m => m s
get
let ns :: [Name]
ns = [ Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v | StCall Analysis a
_ SrcSpan
_ v :: Expression (Analysis a)
v@ExpValue{} AList Argument (Analysis a)
_ <- ProgramUnit (Analysis a) -> [Statement (Analysis a)]
forall a. Data a => ProgramUnit a -> [Statement a]
uS ProgramUnit (Analysis a)
pu ] [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++
[ Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v | ExpFunctionCall Analysis a
_ SrcSpan
_ v :: Expression (Analysis a)
v@ExpValue{} AList Argument (Analysis a)
_ <- ProgramUnit (Analysis a) -> [Expression (Analysis a)]
forall a. Data a => ProgramUnit a -> [Expression a]
uE ProgramUnit (Analysis a)
pu ]
CallMap -> State CallMap ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (CallMap -> State CallMap ()) -> CallMap -> State CallMap ()
forall a b. (a -> b) -> a -> b
$ ProgramUnitName -> Set Name -> CallMap -> CallMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ProgramUnitName
n ([Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList [Name]
ns) CallMap
m
converge :: (a -> a -> Bool) -> [a] -> a
converge :: forall a. (a -> a -> Bool) -> [a] -> a
converge a -> a -> Bool
p (a
x:ys :: [a]
ys@(a
y:[a]
_))
| a -> a -> Bool
p a
x a
y = a
y
| Bool
otherwise = (a -> a -> Bool) -> [a] -> a
forall a. (a -> a -> Bool) -> [a] -> a
converge a -> a -> Bool
p [a]
ys
converge a -> a -> Bool
_ [] = Name -> a
forall a. HasCallStack => Name -> a
error Name
"converge: empty list"
converge a -> a -> Bool
_ [a
_] = Name -> a
forall a. HasCallStack => Name -> a
error Name
"converge: finite list"
fromJustMsg :: String -> Maybe a -> a
fromJustMsg :: forall a. Name -> Maybe a -> a
fromJustMsg Name
_ (Just a
x) = a
x
fromJustMsg Name
msg Maybe a
_ = Name -> a
forall a. HasCallStack => Name -> a
error Name
msg