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
, ParameterVarMap, ConstExpMap, genConstExpMap, analyseConstExps, analyseParameterVars
, 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)
import qualified Language.Fortran.Repr as Repr
import qualified Language.Fortran.Repr.Eval.Value as Repr
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 = forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ 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)
init forall a. OrderF a
revPostOrder (Int -> BBNodeSet) -> Int -> BBNodeSet
inn (Int -> BBNodeSet) -> Int -> BBNodeSet
out
where
gr :: Gr (BB a) ()
gr = forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr a
bbgr
nodeSet :: BBNodeSet
nodeSet = [Int] -> BBNodeSet
IS.fromList forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Int]
nodes Gr (BB a) ()
gr
init :: Int -> (BBNodeSet, BBNodeSet)
init Int
_ = (BBNodeSet
nodeSet, BBNodeSet
nodeSet)
inn :: (Int -> BBNodeSet) -> Int -> BBNodeSet
inn Int -> BBNodeSet
outF Int
n
| preNodes :: [Int]
preNodes@(Int
_:[Int]
_) <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
pre Gr (BB a) ()
gr Int
n = forall a. (a -> a -> a) -> [a] -> a
foldl1' BBNodeSet -> BBNodeSet -> BBNodeSet
IS.intersection forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Int -> BBNodeSet
outF forall a b. (a -> b) -> a -> b
$ [Int]
preNodes
| Bool
otherwise = BBNodeSet
IS.empty
out :: (Int -> BBNodeSet) -> Int -> BBNodeSet
out Int -> BBNodeSet
inF Int
n = Int -> BBNodeSet -> BBNodeSet
IS.insert Int
n forall a b. (a -> b) -> a -> b
$ Int -> BBNodeSet
inF Int
n
type IDomMap = BBNodeMap BBNode
iDominators :: BBGr a -> IDomMap
iDominators :: forall a. BBGr a -> IDomMap
iDominators BBGr a
gr = forall (f :: * -> *) a. Foldable f => f (IntMap a) -> IntMap a
IM.unions [ forall a. [(Int, a)] -> IntMap a
IM.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [(Int, Int)]
iDom Int
n forall a b. (a -> b) -> a -> b
$ forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr a
gr | Int
n <- 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [a]
postorder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> [Tree Int]
dff (forall a. OrderF a
bbgrEntries BBGr a
gr) forall a b. (a -> b) -> a -> b
$ forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr a
gr
revPostOrder :: OrderF a
revPostOrder :: forall a. OrderF a
revPostOrder = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. OrderF a
postOrder
preOrder :: OrderF a
preOrder :: forall a. OrderF a
preOrder BBGr a
gr = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [a]
preorder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> [Tree Int]
dff (forall a. OrderF a
bbgrEntries BBGr a
gr) forall a b. (a -> b) -> a -> b
$ forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr a
gr
revPreOrder :: OrderF a
revPreOrder :: forall a. OrderF a
revPreOrder = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. (a -> a -> Bool) -> [a] -> a
converge forall a. Eq a => a -> a -> Bool
(==) forall a b. (a -> b) -> a -> b
$ 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 = 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 = forall a. [(Int, a)] -> IntMap a
IM.fromList [ (Int
n, (OutF t -> OutF t
inF (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. IntMap a -> Int -> a
get' InOutMap t
m) Int
n, OutF t -> OutF t
outF (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Name -> Maybe a -> a
fromJustMsg (Name
"dataFlowSolver: get " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Name
show Int
n) forall a b. (a -> b) -> a -> b
$ 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 forall a b. NFData a => a -> b -> b
`deepseq` t
x 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 = forall a. [(Int, a)] -> IntMap a
IM.fromList [ (Int
i, Block (Analysis a)
b) | BBGr (Analysis a)
gr <- forall a. Data a => ProgramFile (Analysis a) -> [BBGr (Analysis a)]
uni ProgramFile (Analysis a)
pf
, (Int
_, BB (Analysis a)
bs) <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes forall a b. (a -> b) -> a -> b
$ forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr
, Block (Analysis a)
b <- BB (Analysis a)
bs
, let Just Int
i = forall a. Analysis a -> Maybe Int
insLabel (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 = 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 = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith BBNodeSet -> BBNodeSet -> BBNodeSet
IS.union [
(Name
y, Int -> BBNodeSet
IS.singleton Int
i) | (Int
i, Block (Analysis a)
b) <- forall a. IntMap a -> [(Int, a)]
IM.toList BlockMap a
bm, Name
y <- 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 = 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 (forall a b. a -> b -> a
const (forall a. Set a
S.empty, forall a. Set a
S.empty)) forall a. OrderF a
revPreOrder (Int -> Set Name) -> Int -> Set Name
inn (Int -> Set Name) -> Int -> Set Name
out
where
inn :: (Int -> Set Name) -> Int -> Set Name
inn Int -> Set Name
outF Int
b = (Int -> Set Name
outF Int
b forall a. Ord a => Set a -> Set a -> Set a
S.\\ Int -> Set Name
kill Int
b) forall a. Ord a => Set a -> Set a -> Set a
`S.union` Int -> Set Name
gen Int
b
out :: (Int -> Set Name) -> Int -> Set Name
out Int -> Set Name
innF Int
b = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions [ Int -> Set Name
innF Int
s | Int
s <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
suc (forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
b ]
kill :: Int -> Set Name
kill Int
b = forall a. Data a => [Block (Analysis a)] -> Set Name
bblockKill (forall a. Name -> Maybe a -> a
fromJustMsg Name
"liveVariableAnalysis kill" forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
b)
gen :: Int -> Set Name
gen Int
b = forall a. Data a => [Block (Analysis a)] -> Set Name
bblockGen (forall a. Name -> Maybe a -> a
fromJustMsg Name
"liveVariableAnalysis gen" forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (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 = forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 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 = forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}. Eq a => ([a], [a]) -> ([a], [a]) -> ([a], [a])
f ([], []) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Data a => Block (Analysis a) -> [Name]
blockGen forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& 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 forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
bbkill) forall a. Eq a => [a] -> [a] -> [a]
`union` [a]
bbgen, [a]
kill 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 = 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 = 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) -> InOutMap BBNodeSet
reachingDefinitions DefMap
dm BBGr (Analysis a)
gr = 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 (forall a b. a -> b -> a
const (BBNodeSet
IS.empty, BBNodeSet
IS.empty)) forall a. OrderF a
revPostOrder (Int -> BBNodeSet) -> Int -> BBNodeSet
inn (Int -> BBNodeSet) -> Int -> BBNodeSet
out
where
inn :: (Int -> BBNodeSet) -> Int -> BBNodeSet
inn Int -> BBNodeSet
outF Int
b = forall (f :: * -> *). Foldable f => f BBNodeSet -> BBNodeSet
IS.unions [ Int -> BBNodeSet
outF Int
s | Int
s <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
pre (forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
b ]
out :: (Int -> BBNodeSet) -> Int -> BBNodeSet
out Int -> BBNodeSet
innF Int
b = BBNodeSet
gen BBNodeSet -> BBNodeSet -> BBNodeSet
`IS.union` (Int -> BBNodeSet
innF Int
b BBNodeSet -> BBNodeSet -> BBNodeSet
IS.\\ BBNodeSet
kill)
where (BBNodeSet
gen, BBNodeSet
kill) = forall a.
Data a =>
DefMap -> [Block (Analysis a)] -> (BBNodeSet, BBNodeSet)
rdBblockGenKill DefMap
dm (forall a. Name -> Maybe a -> a
fromJustMsg Name
"reachingDefinitions" forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (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 = 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) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. Data a => Block (Analysis a) -> BBNodeSet
gen 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 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. Data a => Block (Analysis a) -> [Name]
allLhsVars Block (Analysis a)
b) = BBNodeSet
IS.empty
| Bool
otherwise = Int -> BBNodeSet
IS.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Name -> Maybe a -> a
fromJustMsg Name
"rdBblockGenKill" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Analysis a -> Maybe Int
insLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation forall a b. (a -> b) -> a -> b
$ Block (Analysis a)
b
kill :: Block (Analysis a) -> BBNodeSet
kill = 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 = forall (f :: * -> *). Foldable f => f BBNodeSet -> BBNodeSet
IS.unions [ BBNodeSet
IS.empty forall a. a -> Maybe a -> a
`fromMaybe` forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
y DefMap
dm | Name
y <- 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) -> InOutMap BBNodeSet -> DomMap
genDUMap BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr InOutMap BBNodeSet
rdefs = 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 = [ forall a b. (a, b) -> a
fst (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (DomMap, BBNodeSet) -> Block (Analysis a) -> (DomMap, BBNodeSet)
inBBlock (forall a. IntMap a
IM.empty, BBNodeSet
is) BB (Analysis a)
bs) |
(Int
n, (BBNodeSet
is, BBNodeSet
_)) <- forall a. IntMap a -> [(Int, a)]
IM.toList InOutMap BBNodeSet
rdefs,
let Just BB (Analysis a)
bs = forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (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 = forall a. Analysis a -> Maybe Int
insLabel (forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Block (Analysis a)
b)
bduMap :: DomMap
bduMap = forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith BBNodeSet -> BBNodeSet -> BBNodeSet
IS.union [ (Int
i', Int -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> [a]
intersect [Name]
uses forall a b. (a -> b) -> a -> b
$ forall a. Data a => Block (Analysis a) -> [Name]
blockVarDefs Block (Analysis a)
b'
where Just Block (Analysis a)
b' = forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i' BlockMap a
bm
uses :: [Name]
uses = forall a. Data a => Block (Analysis a) -> [Name]
blockVarUses Block (Analysis a)
b
duMap' :: DomMap
duMap' = 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' | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. Data a => Block (Analysis a) -> [Name]
allLhsVars Block (Analysis a)
b') = BBNodeSet
IS.empty
| Bool
otherwise = Int -> BBNodeSet
IS.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Name -> Maybe a -> a
fromJustMsg Name
"genDUMap" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Analysis a -> Maybe Int
insLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation forall a b. (a -> b) -> a -> b
$ Block (Analysis a)
b'
kill :: Block (Analysis a) -> BBNodeSet
kill = 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` 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 = forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith BBNodeSet -> BBNodeSet -> BBNodeSet
IS.union [
(Int
use, Int -> BBNodeSet
IS.singleton Int
def) | (Int
def, BBNodeSet
uses) <- 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) -> InOutMap BBNodeSet -> DomMap
genUDMap BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr = DomMap -> DomMap
duMapToUdMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Data a =>
BlockMap a
-> DefMap -> BBGr (Analysis a) -> InOutMap 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 = forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [(Int, Block (Analysis a))]
nodes' [(Int, Int, ())]
edges'
where
nodes' :: [(Int, Block (Analysis a))]
nodes' = [ (Int
i, Block (Analysis a)
iLabel) | Int
i <- forall a. IntMap a -> [Int]
IM.keys DomMap
m forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BBNodeSet -> [Int]
IS.toList (forall a. IntMap a -> [a]
IM.elems DomMap
m)
, let iLabel :: Block (Analysis a)
iLabel = forall a. Name -> Maybe a -> a
fromJustMsg Name
"mapToGraph" (forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i BlockMap a
bm) ]
edges' :: [(Int, Int, ())]
edges' = [ (Int
i, Int
j, ()) | (Int
i, BBNodeSet
js) <- 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)
-> InOutMap BBNodeSet
-> FlowsGraph a
genFlowsToGraph BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr = forall (gr :: * -> * -> *) a.
DynGraph gr =>
BlockMap a -> DomMap -> gr (Block (Analysis a)) ()
mapToGraph BlockMap a
bm forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Data a =>
BlockMap a
-> DefMap -> BBGr (Analysis a) -> InOutMap 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 = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Ord a => Set a -> Set a -> Set a
S.union [ (Int -> Name
conv Int
u, Int -> Set Name
sconv Int
v) | (Int
u, Int
v) <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [(Int, Int)]
edges FlowsGraph a
fg ]
where
sconv :: Int -> Set Name
sconv Int
i | Just Name
v <- forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i IntMap Name
revDM = forall a. a -> Set a
S.singleton Name
v
| Bool
otherwise = forall a. Set a
S.empty
conv :: Int -> Name
conv Int
i | Just Name
v <- forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i IntMap Name
revDM = Name
v
| Bool
otherwise = forall a. HasCallStack => Name -> a
error forall a b. (a -> b) -> a -> b
$ Name
"genVarFlowsToMap: convert failed, i=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Name
show Int
i
revDM :: IntMap Name
revDM = forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall a b. (a, b) -> a
fst) [ (Int
i, Name
v) | (Name
v, BBNodeSet
is) <- 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) forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
31::Integer)
maxConst :: Integer
maxConst :: Integer
maxConst = (Integer
2::Integer) forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
31::Integer) forall a. Num a => a -> a -> a
- (Integer
1::Integer)
inBounds :: Integer -> Bool
inBounds :: Integer -> Bool
inBounds Integer
x = Integer
minConst forall a. Ord a => a -> a -> Bool
<= Integer
x Bool -> Bool -> Bool
&& Integer
x forall a. Ord a => a -> a -> Bool
<= Integer
maxConst
type ParameterVarMap = M.Map Name Repr.FValue
type ConstExpMap = ASTExprNodeMap (Maybe Repr.FValue)
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 FValue)
pvMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
[ (forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v, Expression (Analysis a) -> Maybe FValue
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)
_) <- forall from to. Biplate from to => from -> [to]
universeBi ProgramFile (Analysis a)
pf :: [Statement (Analysis a)]
, AttrParameter Analysis a
_ SrcSpan
_ <- 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)) <- forall from to. Biplate from to => from -> [to]
universeBi Statement (Analysis a)
st ] forall a. [a] -> [a] -> [a]
++
[ (forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v, Expression (Analysis a) -> Maybe FValue
getE Expression (Analysis a)
e)
| st :: Statement (Analysis a)
st@StParameter{} <- 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)) <- forall from to. Biplate from to => from -> [to]
universeBi Statement (Analysis a)
st ]
getV :: Expression (Analysis a) -> Maybe Repr.FValue
getV :: Expression (Analysis a) -> Maybe FValue
getV Expression (Analysis a)
e = forall a. Analysis a -> Maybe FValue
constExp (forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
e) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Name (Maybe FValue)
pvMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Expression (Analysis a) -> Name
varName forall a b. (a -> b) -> a -> b
$ Expression (Analysis a)
e)
ceMap :: ConstExpMap
ceMap = forall a. [(Int, a)] -> IntMap a
IM.fromList [ (Int
label, Expression (Analysis a) -> Maybe FValue
doExpr Expression (Analysis a)
e) | Expression (Analysis a)
e <- forall from to. Biplate from to => from -> [to]
universeBi ProgramFile (Analysis a)
pf, Just Int
label <- [forall {a}. Expression (Analysis a) -> Maybe Int
labelOf Expression (Analysis a)
e] ]
getE :: Expression (Analysis a) -> Maybe Repr.FValue
getE :: Expression (Analysis a) -> Maybe FValue
getE = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> IntMap a -> Maybe a
IM.lookup ConstExpMap
ceMap forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall {a}. Expression (Analysis a) -> Maybe Int
labelOf)
labelOf :: Expression (Analysis a) -> Maybe Int
labelOf = forall a. Analysis a -> Maybe Int
insLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation
doExpr :: Expression (Analysis a) -> Maybe Repr.FValue
doExpr :: Expression (Analysis a) -> Maybe FValue
doExpr Expression (Analysis a)
e =
case forall a.
Map Name FValue -> FEvalValuePure a -> Either Error (a, [Name])
Repr.runEvalFValuePure forall a. Monoid a => a
mempty (forall (m :: * -> *) a.
MonadFEvalValue m =>
Expression a -> m FValue
Repr.evalExpr Expression (Analysis a)
e) of
Left Error
_err -> forall a. Maybe a
Nothing
Right (FValue
a, [Name]
_msgs) -> forall a. a -> Maybe a
Just FValue
a
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 = 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 (forall a b. (Gr (BB a) () -> Gr (BB b) ()) -> BBGr a -> BBGr b
bbgrMap (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))) forall a b. (a -> b) -> a -> b
$ 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a. Annotated f => (a -> a) -> f a -> f a
modifyAnnotation Expression (Analysis a)
e forall a b. (a -> b) -> a -> b
$ \ Analysis a
a ->
Analysis a
a { constExp :: Maybe FValue
constExp = forall a. Analysis a -> Maybe FValue
constExp Analysis a
a forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> IntMap a -> Maybe a
IM.lookup ConstExpMap
ceMap forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Analysis a -> Maybe Int
insLabel (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 = 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 = 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 =>
Map Name FValue
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseParameterVars Map Name FValue
pvm = 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 FValue
con <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
e) Map Name FValue
pvm = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a. Annotated f => (a -> a) -> f a -> f a
modifyAnnotation Expression (Analysis a)
e forall a b. (a -> b) -> a -> b
$ \ Analysis a
a -> Analysis a
a { constExp :: Maybe FValue
constExp = forall a. a -> Maybe a
Just FValue
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 = forall a. [(Int, a)] -> IntMap a
IM.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Int, Int) -> Bool
isBackEdge forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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` forall a. Name -> Maybe a -> a
fromJustMsg Name
"genBackEdgeMap" (Int
s 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
nforall a. a -> [a] -> [a]
:forall a. Eq a => [a] -> [a] -> [a]
intersect (forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> [Int]
sccWith Int
n gr a b
gr) (forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> [Int]
rdfs [Int
m] (forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> gr a b
delNode Int
n gr a b
gr))) | (Int
m, Int
n) <- 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 = forall a. [(Int, a)] -> IntMap a
IM.fromList [
(Int
n, [Int] -> BBNodeSet
IS.fromList (Int
nforall a. a -> [a] -> [a]
:forall a. Eq a => [a] -> [a] -> [a]
intersect (forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> [Int]
sccWith Int
n gr a b
gr) (forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> [Int]
rdfs [Int
m] (forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> gr a b
delNode Int
n gr a b
gr)))) | (Int
m, Int
n) <- 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 forall a. (a -> Bool) -> [a] -> [a]
filter (Int
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) forall a b. (a -> b) -> a -> b
$ 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 = forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith forall a. Ord a => Set a -> Set a -> Set a
S.union [
(Int
n, forall a. a -> Set a
S.singleton Name
v) | (Int
_, Int
n) <- forall a. IntMap a -> [(Int, a)]
IM.toList IDomMap
bedges
, let Just BB (Analysis a)
bs = forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (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 <- 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => IDomMap -> BBGr (Analysis a) -> InductionVarMap
genInductionVarMap IDomMap
bedges forall a b. (a -> b) -> a -> b
$ BBGr (Analysis a)
gr
where
lnMap :: DomMap
lnMap = forall (gr :: * -> * -> *) a b.
Graph gr =>
IDomMap -> gr a b -> DomMap
genLoopNodeMap IDomMap
bedges forall a b. (a -> b) -> a -> b
$ forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr
get' :: Int -> BBNodeSet
get' = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => Name -> a
error Name
"missing loop-header node") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> IntMap a -> Maybe a
IM.lookup DomMap
lnMap
astLabels :: Int -> [Int]
astLabels Int
n = [ Int
i | Block (Analysis a)
b <- (forall from to. Biplate from to => from -> [to]
universeBi :: Maybe [Block (Analysis a)] -> [Block (Analysis a)]) (forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
n)
, let Just Int
i = forall a. Analysis a -> Maybe Int
insLabel (forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Block (Analysis a)
b) ]
loopsToLabs :: InductionVarMap -> InductionVarMap
loopsToLabs = forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith forall a. Ord a => Set a -> Set a -> Set a
S.union forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, Set Name) -> [(Int, Set Name)]
loopToLabs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
IM.toList
loopToLabs :: (Int, Set Name) -> [(Int, Set Name)]
loopToLabs (Int
n, Set Name
ivs) = (forall a b. (a -> b) -> [a] -> [b]
map (,Set Name
ivs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int]
astLabels) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BBNodeSet -> [Int]
IS.toList (Int -> BBNodeSet
get' Int
n)
data InductionExpr
= IETop
| IELinear !Name !Int !Int
| IEBottom
deriving (Int -> InductionExpr -> ShowS
[InductionExpr] -> ShowS
InductionExpr -> Name
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [InductionExpr] -> ShowS
$cshowList :: [InductionExpr] -> ShowS
show :: InductionExpr -> Name
$cshow :: InductionExpr -> Name
showsPrec :: Int -> InductionExpr -> ShowS
$cshowsPrec :: Int -> InductionExpr -> ShowS
Show, InductionExpr -> InductionExpr -> Bool
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
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. 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
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 -> ShowS
[IEFlow] -> ShowS
IEFlow -> Name
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [IEFlow] -> ShowS
$cshowList :: [IEFlow] -> ShowS
show :: IEFlow -> Name
$cshow :: IEFlow -> Name
showsPrec :: Int -> IEFlow -> ShowS
$cshowsPrec :: Int -> IEFlow -> ShowS
Show, IEFlow -> IEFlow -> Bool
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
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. 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
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 = 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 = 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 forall k a. Map k a
M.empty 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 = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith InductionExpr -> InductionExpr -> InductionExpr
joinInductionExprs (forall a b. (a -> b) -> [a] -> [b]
map IEFlow -> Map Name InductionExpr
ieFlowVars [IEFlow]
flows)
flowE :: DerivedInductionMap
flowE = forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IMS.unionsWith InductionExpr -> InductionExpr -> InductionExpr
joinInductionExprs (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IEFlow] -> IEFlow
joinIEFlows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [a]
IMS.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a
IMS.filterWithKey Int -> (IEFlow, IEFlow) -> Bool
inLoop forall a b. (a -> b) -> a -> b
$ InOutMap IEFlow
inOutMaps
where
bivMap :: InductionVarMap
bivMap = forall a. Data a => IDomMap -> BBGr (Analysis a) -> InductionVarMap
basicInductionVars IDomMap
bedges BBGr (Analysis a)
gr
loopNodeSet :: BBNodeSet
loopNodeSet = forall (f :: * -> *). Foldable f => f BBNodeSet -> BBNodeSet
IS.unions (forall (gr :: * -> * -> *) a b.
Graph gr =>
IDomMap -> gr a b -> [BBNodeSet]
loopNodes IDomMap
bedges forall a b. (a -> b) -> a -> b
$ forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr)
inLoop :: Int -> (IEFlow, IEFlow) -> Bool
inLoop Int
i (IEFlow, IEFlow)
_ = 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
_ <- forall a. Analysis a -> Maybe Int
insLabel (forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
rhs), IEFlow
flow'' <- Name -> InductionExpr -> IEFlow -> IEFlow
ieFlowInsertVar (forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
lv) (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' = 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 -> forall a.
Data a =>
Expression (Analysis a) -> State IEFlow InductionExpr
derivedInductionExprM Expression (Analysis a)
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 = 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 = forall a.
Data a =>
IEFlow -> Expression (Analysis a) -> InductionExpr
derivedInductionExpr IEFlow
flow Expression (Analysis a)
e
label :: Int
label = forall a. Name -> Maybe a -> a
fromJustMsg Name
"stepExpr" forall a b. (a -> b) -> a -> b
$ forall a. Analysis a -> Maybe Int
insLabel (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 [forall a b. (a, b) -> a
fst (Int -> (IEFlow, IEFlow)
initF Int
node), InF IEFlow
inF Int
node]
flow' :: IEFlow
flow' = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IEFlow -> Block (Analysis a) -> IEFlow
step IEFlow
flow (forall a. Name -> Maybe a -> a
fromJustMsg (Name
"analyseDerivedIE out(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Name
show Int
node forall a. [a] -> [a] -> [a]
++ Name
")") forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (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 <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
pre (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 forall a. Int -> IntMap a -> Maybe a
IMS.lookup Int
node InductionVarMap
bivMap of
Just Set Name
set -> (Map Name InductionExpr -> DerivedInductionMap -> IEFlow
IEFlow (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 <- forall a. Set a -> [a]
S.toList Set Name
set ]) forall a. IntMap a
IMS.empty, IEFlow
emptyIEFlow)
Maybe (Set Name)
Nothing -> (IEFlow
emptyIEFlow, IEFlow
emptyIEFlow)
inOutMaps :: InOutMap IEFlow
inOutMaps = 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 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 <- forall a. Analysis a -> Maybe Int
insLabel (forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
e)
, Just InductionExpr
iexpr <- forall a. Int -> IntMap a -> Maybe a
IMS.lookup Int
label (IEFlow -> DerivedInductionMap
ieFlowExprs IEFlow
flow) = InductionExpr
iexpr
| Bool
otherwise = 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
_)) -> forall a. a -> Maybe a -> a
fromMaybe InductionExpr
IETop forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (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 forall a b. (a -> b) -> a -> b
$ 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 = 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 <- 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 <- forall a. Analysis a -> Maybe Int
insLabel (forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
e')
, Just InductionExpr
iexpr <- forall a. Int -> IntMap a -> Maybe a
IMS.lookup Int
label (IEFlow -> DerivedInductionMap
ieFlowExprs IEFlow
flow) = forall (f :: * -> *) a. Applicative f => a -> f a
pure InductionExpr
iexpr
| Bool
otherwise = 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
_)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe InductionExpr
IETop forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (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))
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Name -> Int -> Int -> InductionExpr
IELinear Name
"" Int
0 forall a b. (a -> b) -> a -> b
$ 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression (Analysis a) -> State IEFlow InductionExpr
derive Expression (Analysis a)
e1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression (Analysis a) -> State IEFlow InductionExpr
derive Expression (Analysis a)
e1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (InductionExpr -> InductionExpr
negInductionExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression (Analysis a) -> State IEFlow InductionExpr
derive Expression (Analysis a)
e1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression (Analysis a) -> State IEFlow InductionExpr
derive Expression (Analysis a)
e2
Expression (Analysis a)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ InductionExpr
IETop
let Just Int
label = forall a. Analysis a -> Maybe Int
insLabel (forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
e)
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Int -> InductionExpr -> IEFlow -> IEFlow
ieFlowInsertExpr Int
label InductionExpr
ie IEFlow
flow
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 forall a. Eq a => a -> a -> Bool
== Name
rn = Name -> Int -> Int -> InductionExpr
IELinear Name
ln (Int
lc forall a. Num a => a -> a -> a
+ Int
rc) (Int
lo forall a. Num a => a -> a -> a
+ Int
ro)
| Int
lc forall a. Eq a => a -> a -> Bool
== Int
0 = Name -> Int -> Int -> InductionExpr
IELinear Name
rn Int
rc (Int
lo forall a. Num a => a -> a -> a
+ Int
ro)
| Int
rc forall a. Eq a => a -> a -> Bool
== Int
0 = Name -> Int -> Int -> InductionExpr
IELinear Name
ln Int
lc (Int
lo 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 forall a. Num a => a -> a -> a
* Int
lo) (Int
ro 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 forall a. Num a => a -> a -> a
* Int
ro) (Int
lo 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 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 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 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 } <- forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation ProgramUnit (Analysis a)
pu =
Name
dashes forall a. [a] -> [a] -> [a]
++ Name
"\n" forall a. [a] -> [a] -> [a]
++ Name
p forall a. [a] -> [a] -> [a]
++ Name
"\n" forall a. [a] -> [a] -> [a]
++ Name
dashes forall a. [a] -> [a] -> [a]
++ Name
"\n" forall a. [a] -> [a] -> [a]
++ BBGr (Analysis a) -> Name
dfStr BBGr (Analysis a)
gr forall a. [a] -> [a] -> [a]
++ Name
"\n\n"
where p :: Name
p = Name
"| Program Unit " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Name
show (forall a. ProgramUnit (Analysis a) -> ProgramUnitName
puName ProgramUnit (Analysis a)
pu) forall a. [a] -> [a] -> [a]
++ Name
" |"
dashes :: Name
dashes = forall a. Int -> a -> [a]
replicate (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'forall a. a -> [a] -> [a]
:Name
l forall a. [a] -> [a] -> [a]
++ Name
": " forall a. [a] -> [a] -> [a]
++ Name
x) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [
(Name
"callMap", forall a. Show a => a -> Name
show CallMap
cm)
, (Name
"postOrder", forall a. Show a => a -> Name
show (forall a. OrderF a
postOrder BBGr (Analysis a)
gr))
, (Name
"revPostOrder", forall a. Show a => a -> Name
show (forall a. OrderF a
revPostOrder BBGr (Analysis a)
gr))
, (Name
"revPreOrder", forall a. Show a => a -> Name
show (forall a. OrderF a
revPreOrder BBGr (Analysis a)
gr))
, (Name
"dominators", forall a. Show a => a -> Name
show (forall a. BBGr a -> DomMap
dominators BBGr (Analysis a)
gr))
, (Name
"iDominators", forall a. Show a => a -> Name
show (forall a. BBGr a -> IDomMap
iDominators BBGr (Analysis a)
gr))
, (Name
"defMap", forall a. Show a => a -> Name
show DefMap
dm)
, (Name
"lva", forall a. Show a => a -> Name
show (forall a. IntMap a -> [(Int, a)]
IM.toList forall a b. (a -> b) -> a -> b
$ BBGr (Analysis a) -> InOutMap (Set Name)
lva BBGr (Analysis a)
gr))
, (Name
"rd", forall a. Show a => a -> Name
show (forall a. IntMap a -> [(Int, a)]
IM.toList forall a b. (a -> b) -> a -> b
$ BBGr (Analysis a) -> InOutMap BBNodeSet
rd BBGr (Analysis a)
gr))
, (Name
"backEdges", forall a. Show a => a -> Name
show IDomMap
bedges)
, (Name
"topsort", forall a. Show a => a -> Name
show (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Int]
topsort forall a b. (a -> b) -> a -> b
$ forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr))
, (Name
"scc ", forall a. Show a => a -> Name
show (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Int]]
scc forall a b. (a -> b) -> a -> b
$ forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr))
, (Name
"loopNodes", forall a. Show a => a -> Name
show (forall (gr :: * -> * -> *) a b.
Graph gr =>
IDomMap -> gr a b -> [BBNodeSet]
loopNodes IDomMap
bedges forall a b. (a -> b) -> a -> b
$ forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr))
, (Name
"duMap", forall a. Show a => a -> Name
show (forall a.
Data a =>
BlockMap a
-> DefMap -> BBGr (Analysis a) -> InOutMap BBNodeSet -> DomMap
genDUMap BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr (BBGr (Analysis a) -> InOutMap BBNodeSet
rd BBGr (Analysis a)
gr)))
, (Name
"udMap", forall a. Show a => a -> Name
show (forall a.
Data a =>
BlockMap a
-> DefMap -> BBGr (Analysis a) -> InOutMap BBNodeSet -> DomMap
genUDMap BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr (BBGr (Analysis a) -> InOutMap BBNodeSet
rd BBGr (Analysis a)
gr)))
, (Name
"flowsTo", forall a. Show a => a -> Name
show (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [(Int, Int)]
edges FlowsGraph a
flTo))
, (Name
"varFlowsTo", forall a. Show a => a -> Name
show (forall a. Data a => DefMap -> FlowsGraph a -> VarFlowsMap
genVarFlowsToMap DefMap
dm (forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> InOutMap BBNodeSet
-> FlowsGraph a
genFlowsToGraph BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr (BBGr (Analysis a) -> InOutMap BBNodeSet
rd BBGr (Analysis a)
gr))))
, (Name
"ivMap", forall a. Show a => a -> Name
show (forall a. Data a => IDomMap -> BBGr (Analysis a) -> InductionVarMap
genInductionVarMap IDomMap
bedges BBGr (Analysis a)
gr))
, (Name
"ivMapByAST", forall a. Show a => a -> Name
show (forall a. Data a => IDomMap -> BBGr (Analysis a) -> InductionVarMap
genInductionVarMapByASTBlock IDomMap
bedges BBGr (Analysis a)
gr))
, (Name
"constExpMap", forall a. Show a => a -> Name
show (forall a. Data a => ProgramFile (Analysis a) -> ConstExpMap
genConstExpMap ProgramFile (Analysis a)
pf))
, (Name
"entries", forall a. Show a => a -> Name
show (forall a. OrderF a
bbgrEntries BBGr (Analysis a)
gr))
, (Name
"exits", forall a. Show a => a -> Name
show (forall a. OrderF a
bbgrExits BBGr (Analysis a)
gr))
] where
bedges :: IDomMap
bedges = forall (gr :: * -> * -> *) a b.
Graph gr =>
DomMap -> gr a b -> IDomMap
genBackEdgeMap (forall a. BBGr a -> DomMap
dominators BBGr (Analysis a)
gr) forall a b. (a -> b) -> a -> b
$ forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr
flTo :: FlowsGraph a
flTo = forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> InOutMap BBNodeSet
-> FlowsGraph a
genFlowsToGraph BlockMap a
bm DefMap
dm BBGr (Analysis a)
gr (BBGr (Analysis a) -> InOutMap BBNodeSet
rd BBGr (Analysis a)
gr)
perPU ProgramUnit (Analysis a)
pu = Name
dashes forall a. [a] -> [a] -> [a]
++ Name
"\n" forall a. [a] -> [a] -> [a]
++ Name
p forall a. [a] -> [a] -> [a]
++ Name
"\n" forall a. [a] -> [a] -> [a]
++ Name
dashes forall a. [a] -> [a] -> [a]
++ Name
"\n" forall a. [a] -> [a] -> [a]
++ Name
dfStr forall a. [a] -> [a] -> [a]
++ Name
"\n\n"
where p :: Name
p = Name
"| Program Unit " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Name
show (forall a. ProgramUnit (Analysis a) -> ProgramUnitName
puName ProgramUnit (Analysis a)
pu) forall a. [a] -> [a] -> [a]
++ Name
" |"
dashes :: Name
dashes = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length Name
p) Char
'-'
dfStr :: Name
dfStr = (\ (Name
l, Name
x) -> Char
'\n'forall a. a -> [a] -> [a]
:Name
l forall a. [a] -> [a] -> [a]
++ Name
": " forall a. [a] -> [a] -> [a]
++ Name
x) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [
(Name
"constExpMap", forall a. Show a => a -> Name
show (forall a. Data a => ProgramFile (Analysis a) -> ConstExpMap
genConstExpMap ProgramFile (Analysis a)
pf))
]
lva :: BBGr (Analysis a) -> InOutMap (Set Name)
lva = forall a. Data a => BBGr (Analysis a) -> InOutMap (Set Name)
liveVariableAnalysis
bm :: BlockMap a
bm = forall a. Data a => ProgramFile (Analysis a) -> BlockMap a
genBlockMap ProgramFile (Analysis a)
pf
dm :: DefMap
dm = forall a. Data a => BlockMap a -> DefMap
genDefMap BlockMap a
bm
rd :: BBGr (Analysis a) -> InOutMap BBNodeSet
rd = forall a.
Data a =>
DefMap -> BBGr (Analysis a) -> InOutMap BBNodeSet
reachingDefinitions DefMap
dm
cm :: CallMap
cm = 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 = forall w a. Writer w a -> w
execWriter forall a b. (a -> b) -> a -> b
$ do
let bm :: BlockMap a
bm = forall a. Data a => ProgramFile (Analysis a) -> BlockMap a
genBlockMap ProgramFile (Analysis a)
pf
dm :: DefMap
dm = forall a. Data a => BlockMap a -> DefMap
genDefMap BlockMap a
bm
flowsTo :: FlowsGraph a
flowsTo = forall a.
Data a =>
BlockMap a
-> DefMap
-> BBGr (Analysis a)
-> InOutMap BBNodeSet
-> FlowsGraph a
genFlowsToGraph BlockMap a
bm DefMap
dm BBGr (Analysis a)
bbgr (forall a.
Data a =>
DefMap -> BBGr (Analysis a) -> InOutMap BBNodeSet
reachingDefinitions DefMap
dm BBGr (Analysis a)
bbgr)
flows :: FlowsGraph a
flows | Bool
isFrom = forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> gr a b
grev FlowsGraph a
flowsTo
| Bool
otherwise = FlowsGraph a
flowsTo
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Name
"strict digraph {\n"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> [Int]
bfsn [Int
astBlockId] FlowsGraph a
flows) forall a b. (a -> b) -> a -> b
$ \ Int
n -> do
let pseudocode :: Name
pseudocode = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Name
"<N/A>" forall a. Block a -> Name
showBlock forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
n BlockMap a
bm
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Name
"node [shape=box,fontname=\"Courier New\"]\n"
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ Name
"Bl" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Name
show Int
n forall a. [a] -> [a] -> [a]
++ Name
"[label=\"B" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Name
show Int
n forall a. [a] -> [a] -> [a]
++ Name
"\\l" forall a. [a] -> [a] -> [a]
++ Name
pseudocode forall a. [a] -> [a] -> [a]
++ Name
"\"]\n"
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ Name
"Bl" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Name
show Int
n forall a. [a] -> [a] -> [a]
++ Name
" -> {"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
suc FlowsGraph a
flows Int
n) forall a b. (a -> b) -> a -> b
$ \ Int
m -> forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Name
" Bl" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Name
show Int
m)
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Name
"}\n"
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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
Lazy.execState forall k a. Map k a
M.empty forall a b. (a -> b) -> a -> b
$ do
let uP :: ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
uP = forall from to. Biplate from to => from -> [to]
universeBi :: Data a => ProgramFile a -> [ProgramUnit a]
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) forall a b. (a -> b) -> a -> b
$ \ ProgramUnit (Analysis a)
pu -> do
let n :: ProgramUnitName
n = 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 = 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 = forall from to. Biplate from to => from -> [to]
universeBi
CallMap
m <- forall s (m :: * -> *). MonadState s m => m s
get
let ns :: [Name]
ns = [ 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)
_ <- forall a. Data a => ProgramUnit a -> [Statement a]
uS ProgramUnit (Analysis a)
pu ] forall a. [a] -> [a] -> [a]
++
[ 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)
_ <- forall a. Data a => ProgramUnit a -> [Expression a]
uE ProgramUnit (Analysis a)
pu ]
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ProgramUnitName
n (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 = forall a. (a -> a -> Bool) -> [a] -> a
converge a -> a -> Bool
p [a]
ys
converge a -> a -> Bool
_ [] = forall a. HasCallStack => Name -> a
error Name
"converge: empty list"
converge a -> a -> Bool
_ [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
_ = forall a. HasCallStack => Name -> a
error Name
msg