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 = 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
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 forall a. Num a => a -> a -> a
+ Integer
y) -> Integer -> Constant
ConstInt (Integer
x forall a. Num a => a -> a -> a
+ Integer
y)
BinaryOp
Subtraction | Integer -> Bool
inBounds (Integer
x forall a. Num a => a -> a -> a
- Integer
y) -> Integer -> Constant
ConstInt (Integer
x forall a. Num a => a -> a -> a
- Integer
y)
BinaryOp
Multiplication | Integer -> Bool
inBounds (Integer
x forall a. Num a => a -> a -> a
* Integer
y) -> Integer -> Constant
ConstInt (Integer
x forall a. Num a => a -> a -> a
* Integer
y)
BinaryOp
Division | Integer
y forall a. Eq a => a -> a -> Bool
/= Integer
0 -> Integer -> Constant
ConstInt (Integer
x forall a. Integral a => a -> a -> a
`div` Integer
y)
BinaryOp
Exponentiation | Integer
y forall a. Ord a => a -> a -> Bool
>= Integer
0 -> Integer -> Constant
ConstInt (Integer
x 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 = 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 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)
_) <- 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 Constant
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 Constant
getV :: Expression (Analysis a) -> Maybe Constant
getV Expression (Analysis a)
e = forall a. Analysis a -> Maybe Constant
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 Constant)
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 Constant
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 Constant
getE :: Expression (Analysis a) -> Maybe Constant
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 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))
_) -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Constant
ConstInt forall a b. (a -> b) -> a -> b
$ forall a. Read a => Name -> a
read Name
intStr
ExpValue Analysis a
_ SrcSpan
_ (ValReal RealLit
r Maybe (KindParam (Analysis a))
_) -> forall a. a -> Maybe a
Just 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnaryOp -> Constant -> Constant
ConstUnary UnaryOp
unOp 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)
_ -> 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 = 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 Constant
constExp = forall a. Analysis a -> Maybe Constant
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 =>
ParameterVarMap
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseParameterVars ParameterVarMap
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 Constant
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) ParameterVarMap
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 Constant
constExp = 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 = 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