module Language.Fortran.Analysis.BBlocks
( analyseBBlocks, genBBlockMap, showBBGr, showAnalysedBBGr, showBBlocks, bbgrToDOT, BBlockMap, ASTBlockNode, ASTExprNode
, genSuperBBGr, SuperBBGr(..), showSuperBBGr, superBBGrToDOT, findLabeledBBlock, showBlock )
where
import Prelude hiding (exp)
import Data.Generics.Uniplate.Data hiding (transform)
import Data.Char (toLower)
import Data.Data
import Data.List (unfoldr, foldl')
import Control.Monad
import Control.Monad.State.Lazy hiding (fix)
import Control.Monad.Writer hiding (fix)
import Text.PrettyPrint.GenericPretty (pretty, Out)
import Text.PrettyPrint (render)
import Language.Fortran.Analysis
import Language.Fortran.AST hiding (setName)
import Language.Fortran.AST.Literal.Real
import Language.Fortran.Util.Position
import Language.Fortran.PrettyPrint
import qualified Data.Map as M
import qualified Data.IntMap as IM
import Data.Graph.Inductive
import Data.List (intercalate)
import Data.Maybe
import Data.Functor.Identity
import qualified Data.List.NonEmpty as NE
analyseBBlocks :: Data a => ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseBBlocks :: forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseBBlocks ProgramFile (Analysis a)
pf = forall s a. State s a -> s -> a
evalState (ProgramFile (Analysis a)
-> StateT ASTExprNode Identity (ProgramFile (Analysis a))
analyse (forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseAllLhsVars ProgramFile (Analysis a)
pf)) ASTExprNode
1
where
analyse :: ProgramFile (Analysis a)
-> StateT ASTExprNode Identity (ProgramFile (Analysis a))
analyse = forall a.
Data a =>
ProgramFile (Analysis a)
-> State ASTExprNode (ProgramFile (Analysis a))
labelExprsInBBGr forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a.
Data a =>
ProgramFile (Analysis a)
-> State ASTExprNode (ProgramFile (Analysis a))
labelBlocksInBBGr forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => TransFunc ProgramUnit ProgramFile a
trans forall a.
Data a =>
ProgramUnit (Analysis a) -> ProgramUnit (Analysis a)
toBBlocksPerPU forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a.
Data a =>
ProgramFile (Analysis a)
-> State ASTExprNode (ProgramFile (Analysis a))
labelExprs forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a.
Data a =>
ProgramFile (Analysis a)
-> State ASTExprNode (ProgramFile (Analysis a))
labelBlocks
trans :: Data a => TransFunc ProgramUnit ProgramFile a
trans :: forall a. Data a => TransFunc ProgramUnit ProgramFile a
trans = forall from to. Biplate from to => (to -> to) -> from -> from
transformBi
type BBlockMap a = M.Map ProgramUnitName (BBGr a)
genBBlockMap :: Data a => ProgramFile (Analysis a) -> BBlockMap (Analysis a)
genBBlockMap :: forall a.
Data a =>
ProgramFile (Analysis a) -> BBlockMap (Analysis a)
genBBlockMap ProgramFile (Analysis a)
pf = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
(forall a. ProgramUnit (Analysis a) -> ProgramUnitName
puName ProgramUnit (Analysis a)
pu, BBGr (Analysis a)
gr) | ProgramUnit (Analysis a)
pu <- forall a.
Data a =>
ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
getPUs ProgramFile (Analysis a)
pf, Just BBGr (Analysis a)
gr <- [forall a. Analysis a -> Maybe (BBGr (Analysis a))
bBlocks (forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation ProgramUnit (Analysis a)
pu)]
]
where
getPUs :: Data a => ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
getPUs :: forall a.
Data a =>
ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
getPUs = forall from to. Biplate from to => from -> [to]
universeBi
type ASTBlockNode = Int
labelBlocks :: Data a => ProgramFile (Analysis a) -> State ASTBlockNode (ProgramFile (Analysis a))
labelBlocks :: forall a.
Data a =>
ProgramFile (Analysis a)
-> State ASTExprNode (ProgramFile (Analysis a))
labelBlocks = forall a.
Data a =>
TransFuncM (StateT ASTExprNode Identity) Block ProgramFile a
transform forall a.
Data a =>
Block (Analysis a) -> State ASTExprNode (Block (Analysis a))
eachBlock
where
eachBlock :: Data a => Block (Analysis a) -> State ASTBlockNode (Block (Analysis a))
eachBlock :: forall a.
Data a =>
Block (Analysis a) -> State ASTExprNode (Block (Analysis a))
eachBlock Block (Analysis a)
b = do
ASTExprNode
n <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ASTExprNode
n forall a. Num a => a -> a -> a
+ ASTExprNode
1)
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => Block (Analysis a) -> Block (Analysis a)
labelWithinBlocks forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Annotated f => a -> f a -> f a
setAnnotation ((forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Block (Analysis a)
b) { insLabel :: Maybe ASTExprNode
insLabel = forall a. a -> Maybe a
Just ASTExprNode
n }) Block (Analysis a)
b
transform :: Data a => TransFuncM (State ASTBlockNode) Block ProgramFile a
transform :: forall a.
Data a =>
TransFuncM (StateT ASTExprNode Identity) Block ProgramFile a
transform = forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM
labelBlocksInBBGr :: Data a => ProgramFile (Analysis a) -> State ASTBlockNode (ProgramFile (Analysis a))
labelBlocksInBBGr :: forall a.
Data a =>
ProgramFile (Analysis a)
-> State ASTExprNode (ProgramFile (Analysis a))
labelBlocksInBBGr = forall a.
Data a =>
(BBGr a -> State ASTExprNode (BBGr a))
-> ProgramFile a -> State ASTExprNode (ProgramFile a)
transform (forall (m :: * -> *) a1 a2.
Monad m =>
(Gr (BB a1) () -> m (Gr (BB a2) ())) -> BBGr a1 -> m (BBGr a2)
bbgrMapM (forall (gr :: * -> * -> *) (m :: * -> *) a c b.
(DynGraph gr, Monad m) =>
(a -> m c) -> gr a b -> m (gr c b)
nmapM' (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a.
Data a =>
Block (Analysis a) -> State ASTExprNode (Block (Analysis a))
eachBlock)))
where
eachBlock :: Data a => Block (Analysis a) -> State ASTBlockNode (Block (Analysis a))
eachBlock :: forall a.
Data a =>
Block (Analysis a) -> State ASTExprNode (Block (Analysis a))
eachBlock Block (Analysis a)
b
| a :: Analysis a
a@Analysis { insLabel :: forall a. Analysis a -> Maybe ASTExprNode
insLabel = Maybe ASTExprNode
Nothing } <- forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Block (Analysis a)
b = do
ASTExprNode
n <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ ASTExprNode
n forall a. Num a => a -> a -> a
+ ASTExprNode
1
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
(Annotated f, Data (f (Analysis a)), Data a) =>
f (Analysis a) -> f (Analysis a)
analyseAllLhsVars1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => Block (Analysis a) -> Block (Analysis a)
labelWithinBlocks forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Annotated f => a -> f a -> f a
setAnnotation (Analysis a
a { insLabel :: Maybe ASTExprNode
insLabel = forall a. a -> Maybe a
Just ASTExprNode
n }) Block (Analysis a)
b
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
(Annotated f, Data (f (Analysis a)), Data a) =>
f (Analysis a) -> f (Analysis a)
analyseAllLhsVars1 forall a b. (a -> b) -> a -> b
$ Block (Analysis a)
b
transform :: Data a => (BBGr a -> State ASTBlockNode (BBGr a)) ->
ProgramFile a -> State ASTBlockNode (ProgramFile a)
transform :: forall a.
Data a =>
(BBGr a -> State ASTExprNode (BBGr a))
-> ProgramFile a -> State ASTExprNode (ProgramFile a)
transform = forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM
labelWithinBlocks :: forall a. Data a => Block (Analysis a) -> Block (Analysis a)
labelWithinBlocks :: forall a. Data a => Block (Analysis a) -> Block (Analysis a)
labelWithinBlocks = Block (Analysis a) -> Block (Analysis a)
perBlock'
where
perBlock' :: Block (Analysis a) -> Block (Analysis a)
perBlock' :: Block (Analysis a) -> Block (Analysis a)
perBlock' Block (Analysis a)
b =
case Block (Analysis a)
b of
BlStatement Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
e Statement (Analysis a)
st -> forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
BlStatement Analysis a
a SrcSpan
s (forall (f :: * -> *).
Data (f (Analysis a)) =>
Maybe ASTExprNode
-> Maybe (f (Analysis a)) -> Maybe (f (Analysis a))
mfill Maybe ASTExprNode
i Maybe (Expression (Analysis a))
e) (forall (f :: * -> *).
Data (f (Analysis a)) =>
Maybe ASTExprNode -> f (Analysis a) -> f (Analysis a)
fill Maybe ASTExprNode
i Statement (Analysis a)
st)
BlIf Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
e1 Maybe String
mn NonEmpty (Expression (Analysis a), [Block (Analysis a)])
bs Maybe [Block (Analysis a)]
mb Maybe (Expression (Analysis a))
el ->
forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe String
-> NonEmpty (Expression a, [Block a])
-> Maybe [Block a]
-> Maybe (Expression a)
-> Block a
BlIf Analysis a
a SrcSpan
s (forall (f :: * -> *).
Data (f (Analysis a)) =>
Maybe ASTExprNode
-> Maybe (f (Analysis a)) -> Maybe (f (Analysis a))
mfill Maybe ASTExprNode
i Maybe (Expression (Analysis a))
e1) Maybe String
mn (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe ASTExprNode
-> (Expression (Analysis a), [Block (Analysis a)])
-> (Expression (Analysis a), [Block (Analysis a)])
fillIf Maybe ASTExprNode
i) NonEmpty (Expression (Analysis a), [Block (Analysis a)])
bs) Maybe [Block (Analysis a)]
mb Maybe (Expression (Analysis a))
el
BlCase Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
e1 Maybe String
mn Expression (Analysis a)
e2 [(AList Index (Analysis a), [Block (Analysis a)])]
bs Maybe [Block (Analysis a)]
mb Maybe (Expression (Analysis a))
el ->
forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe String
-> Expression a
-> [(AList Index a, [Block a])]
-> Maybe [Block a]
-> Maybe (Expression a)
-> Block a
BlCase Analysis a
a SrcSpan
s (forall (f :: * -> *).
Data (f (Analysis a)) =>
Maybe ASTExprNode
-> Maybe (f (Analysis a)) -> Maybe (f (Analysis a))
mfill Maybe ASTExprNode
i Maybe (Expression (Analysis a))
e1) Maybe String
mn (forall (f :: * -> *).
Data (f (Analysis a)) =>
Maybe ASTExprNode -> f (Analysis a) -> f (Analysis a)
fill Maybe ASTExprNode
i Expression (Analysis a)
e2) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe ASTExprNode
-> (AList Index (Analysis a), [Block (Analysis a)])
-> (AList Index (Analysis a), [Block (Analysis a)])
fillCaseClause Maybe ASTExprNode
i) [(AList Index (Analysis a), [Block (Analysis a)])]
bs) Maybe [Block (Analysis a)]
mb Maybe (Expression (Analysis a))
el
BlDo Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
e1 Maybe String
mn Maybe (Expression (Analysis a))
tl Maybe (DoSpecification (Analysis a))
e2 [Block (Analysis a)]
bs Maybe (Expression (Analysis a))
el -> forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe String
-> Maybe (Expression a)
-> Maybe (DoSpecification a)
-> [Block a]
-> Maybe (Expression a)
-> Block a
BlDo Analysis a
a SrcSpan
s (forall (f :: * -> *).
Data (f (Analysis a)) =>
Maybe ASTExprNode
-> Maybe (f (Analysis a)) -> Maybe (f (Analysis a))
mfill Maybe ASTExprNode
i Maybe (Expression (Analysis a))
e1) Maybe String
mn Maybe (Expression (Analysis a))
tl (forall (f :: * -> *).
Data (f (Analysis a)) =>
Maybe ASTExprNode
-> Maybe (f (Analysis a)) -> Maybe (f (Analysis a))
mfill Maybe ASTExprNode
i Maybe (DoSpecification (Analysis a))
e2) [Block (Analysis a)]
bs Maybe (Expression (Analysis a))
el
BlDoWhile Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
e1 Maybe String
n Maybe (Expression (Analysis a))
tl Expression (Analysis a)
e2 [Block (Analysis a)]
bs Maybe (Expression (Analysis a))
el -> forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe String
-> Maybe (Expression a)
-> Expression a
-> [Block a]
-> Maybe (Expression a)
-> Block a
BlDoWhile Analysis a
a SrcSpan
s (forall (f :: * -> *).
Data (f (Analysis a)) =>
Maybe ASTExprNode
-> Maybe (f (Analysis a)) -> Maybe (f (Analysis a))
mfill Maybe ASTExprNode
i Maybe (Expression (Analysis a))
e1) Maybe String
n Maybe (Expression (Analysis a))
tl (forall (f :: * -> *).
Data (f (Analysis a)) =>
Maybe ASTExprNode -> f (Analysis a) -> f (Analysis a)
fill Maybe ASTExprNode
i Expression (Analysis a)
e2) [Block (Analysis a)]
bs Maybe (Expression (Analysis a))
el
Block (Analysis a)
_ -> Block (Analysis a)
b
where i :: Maybe ASTExprNode
i = forall a. Analysis a -> Maybe ASTExprNode
insLabel forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Block (Analysis a)
b
mfill
:: forall f. (Data (f (Analysis a)))
=> Maybe ASTBlockNode -> Maybe (f (Analysis a)) -> Maybe (f (Analysis a))
mfill :: forall (f :: * -> *).
Data (f (Analysis a)) =>
Maybe ASTExprNode
-> Maybe (f (Analysis a)) -> Maybe (f (Analysis a))
mfill Maybe ASTExprNode
i = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *).
Data (f (Analysis a)) =>
Maybe ASTExprNode -> f (Analysis a) -> f (Analysis a)
fill Maybe ASTExprNode
i)
fillCaseClause :: Maybe ASTExprNode
-> (AList Index (Analysis a), [Block (Analysis a)])
-> (AList Index (Analysis a), [Block (Analysis a)])
fillCaseClause Maybe ASTExprNode
i (AList Index (Analysis a)
rs, [Block (Analysis a)]
b) = (forall (f :: * -> *).
Data (f (Analysis a)) =>
Maybe ASTExprNode -> f (Analysis a) -> f (Analysis a)
fill Maybe ASTExprNode
i AList Index (Analysis a)
rs, [Block (Analysis a)]
b)
fillIf :: Maybe ASTExprNode
-> (Expression (Analysis a), [Block (Analysis a)])
-> (Expression (Analysis a), [Block (Analysis a)])
fillIf Maybe ASTExprNode
i (Expression (Analysis a)
e, [Block (Analysis a)]
b) = (forall (f :: * -> *).
Data (f (Analysis a)) =>
Maybe ASTExprNode -> f (Analysis a) -> f (Analysis a)
fill Maybe ASTExprNode
i Expression (Analysis a)
e, [Block (Analysis a)]
b)
fill
:: forall f. (Data (f (Analysis a)))
=> Maybe ASTBlockNode -> f (Analysis a) -> f (Analysis a)
fill :: forall (f :: * -> *).
Data (f (Analysis a)) =>
Maybe ASTExprNode -> f (Analysis a) -> f (Analysis a)
fill Maybe ASTExprNode
Nothing = forall a. a -> a
id
fill (Just ASTExprNode
i) = (Index (Analysis a) -> Index (Analysis a))
-> f (Analysis a) -> f (Analysis a)
transform Index (Analysis a) -> Index (Analysis a)
perIndex
where
transform :: (Index (Analysis a) -> Index (Analysis a)) -> f (Analysis a) -> f (Analysis a)
transform :: (Index (Analysis a) -> Index (Analysis a))
-> f (Analysis a) -> f (Analysis a)
transform = forall from to. Biplate from to => (to -> to) -> from -> from
transformBi
perIndex :: (Index (Analysis a) -> Index (Analysis a))
perIndex :: Index (Analysis a) -> Index (Analysis a)
perIndex Index (Analysis a)
x = forall (f :: * -> *) a. Annotated f => a -> f a -> f a
setAnnotation ((forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Index (Analysis a)
x) { insLabel :: Maybe ASTExprNode
insLabel = forall a. a -> Maybe a
Just ASTExprNode
i }) Index (Analysis a)
x
type ASTExprNode = Int
labelExprs :: Data a => ProgramFile (Analysis a) -> State ASTExprNode (ProgramFile (Analysis a))
labelExprs :: forall a.
Data a =>
ProgramFile (Analysis a)
-> State ASTExprNode (ProgramFile (Analysis a))
labelExprs = forall a.
Data a =>
TransFuncM (StateT ASTExprNode Identity) Expression ProgramFile a
transform forall a.
Data a =>
Expression (Analysis a)
-> State ASTExprNode (Expression (Analysis a))
eachExpr
where
eachExpr :: Data a => Expression (Analysis a) -> State ASTExprNode (Expression (Analysis a))
eachExpr :: forall a.
Data a =>
Expression (Analysis a)
-> State ASTExprNode (Expression (Analysis a))
eachExpr Expression (Analysis a)
e = do
ASTExprNode
n <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ASTExprNode
n forall a. Num a => a -> a -> a
+ ASTExprNode
1)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Annotated f => a -> f a -> f a
setAnnotation ((forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
e) { insLabel :: Maybe ASTExprNode
insLabel = forall a. a -> Maybe a
Just ASTExprNode
n }) Expression (Analysis a)
e
transform :: Data a => TransFuncM (State ASTExprNode) Expression ProgramFile a
transform :: forall a.
Data a =>
TransFuncM (StateT ASTExprNode Identity) Expression ProgramFile a
transform = forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM
labelExprsInBBGr :: Data a => ProgramFile (Analysis a) -> State ASTExprNode (ProgramFile (Analysis a))
labelExprsInBBGr :: forall a.
Data a =>
ProgramFile (Analysis a)
-> State ASTExprNode (ProgramFile (Analysis a))
labelExprsInBBGr = forall a.
Data a =>
(BBGr a -> State ASTExprNode (BBGr a))
-> ProgramFile a -> State ASTExprNode (ProgramFile a)
transformBB (forall (m :: * -> *) a1 a2.
Monad m =>
(Gr (BB a1) () -> m (Gr (BB a2) ())) -> BBGr a1 -> m (BBGr a2)
bbgrMapM (forall (gr :: * -> * -> *) (m :: * -> *) a c b.
(DynGraph gr, Monad m) =>
(a -> m c) -> gr a b -> m (gr c b)
nmapM' (forall a.
Data a =>
(Expression (Analysis a)
-> State ASTExprNode (Expression (Analysis a)))
-> [Block (Analysis a)] -> State ASTExprNode [Block (Analysis a)]
transformExpr forall a.
Data a =>
Expression (Analysis a)
-> State ASTExprNode (Expression (Analysis a))
eachExpr)))
where
eachExpr :: Data a => Expression (Analysis a) -> State ASTExprNode (Expression (Analysis a))
eachExpr :: forall a.
Data a =>
Expression (Analysis a)
-> State ASTExprNode (Expression (Analysis a))
eachExpr Expression (Analysis a)
e
| a :: Analysis a
a@Analysis { insLabel :: forall a. Analysis a -> Maybe ASTExprNode
insLabel = Maybe ASTExprNode
Nothing } <- forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
e = do
ASTExprNode
n <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ ASTExprNode
n forall a. Num a => a -> a -> a
+ ASTExprNode
1
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Annotated f => a -> f a -> f a
setAnnotation (Analysis a
a { insLabel :: Maybe ASTExprNode
insLabel = forall a. a -> Maybe a
Just ASTExprNode
n }) Expression (Analysis a)
e
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return Expression (Analysis a)
e
transformBB :: Data a => (BBGr a -> State ASTExprNode (BBGr a)) ->
ProgramFile a -> State ASTExprNode (ProgramFile a)
transformBB :: forall a.
Data a =>
(BBGr a -> State ASTExprNode (BBGr a))
-> ProgramFile a -> State ASTExprNode (ProgramFile a)
transformBB = forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM
transformExpr :: Data a => (Expression (Analysis a) -> State ASTExprNode (Expression (Analysis a))) ->
[Block (Analysis a)] -> State ASTExprNode [Block (Analysis a)]
transformExpr :: forall a.
Data a =>
(Expression (Analysis a)
-> State ASTExprNode (Expression (Analysis a)))
-> [Block (Analysis a)] -> State ASTExprNode [Block (Analysis a)]
transformExpr = forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM
toBBlocksPerPU :: Data a => ProgramUnit (Analysis a) -> ProgramUnit (Analysis a)
toBBlocksPerPU :: forall a.
Data a =>
ProgramUnit (Analysis a) -> ProgramUnit (Analysis a)
toBBlocksPerPU ProgramUnit (Analysis a)
pu
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block (Analysis a)]
bs = ProgramUnit (Analysis a)
pu
| Bool
otherwise = ProgramUnit (Analysis a)
pu'
where
bs :: [Block (Analysis a)]
bs =
case ProgramUnit (Analysis a)
pu of
PUMain Analysis a
_ SrcSpan
_ Maybe String
_ [Block (Analysis a)]
bs' Maybe [ProgramUnit (Analysis a)]
_ -> [Block (Analysis a)]
bs';
PUSubroutine Analysis a
_ SrcSpan
_ PrefixSuffix (Analysis a)
_ String
_ Maybe (AList Expression (Analysis a))
_ [Block (Analysis a)]
bs' Maybe [ProgramUnit (Analysis a)]
_ -> [Block (Analysis a)]
bs';
PUFunction Analysis a
_ SrcSpan
_ Maybe (TypeSpec (Analysis a))
_ PrefixSuffix (Analysis a)
_ String
_ Maybe (AList Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_ [Block (Analysis a)]
bs' Maybe [ProgramUnit (Analysis a)]
_ -> [Block (Analysis a)]
bs'
ProgramUnit (Analysis a)
_ -> []
bbs :: BBState (Analysis a)
bbs = forall a b. BBlocker a b -> BBState a
execBBlocker (forall a.
Data a =>
[Block (Analysis a)]
-> BBlocker (Analysis a) (ASTExprNode, ASTExprNode)
processBlocks [Block (Analysis a)]
bs)
fix :: Gr [Block (Analysis a)] () -> Gr [Block (Analysis a)] ()
fix = forall (t :: * -> *) (gr :: * -> * -> *) a b.
(Foldable t, DynGraph gr) =>
gr (t a) b -> gr (t a) b
delEmptyBBlocks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> gr a b
delUnreachable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (gr :: * -> * -> *).
(Data a, DynGraph gr) =>
ProgramUnit (Analysis a)
-> Map String ASTExprNode
-> gr [Block (Analysis a)] ()
-> gr [Block (Analysis a)] ()
insExitEdges ProgramUnit (Analysis a)
pu Map String ASTExprNode
lm forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b.
DynGraph gr =>
gr [Block a] b -> gr [Block a] b
delInvalidExits forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (gr :: * -> * -> *).
(Data a, DynGraph gr) =>
ProgramUnit (Analysis a)
-> gr [Block (Analysis a)] () -> gr [Block (Analysis a)] ()
insEntryEdges ProgramUnit (Analysis a)
pu
gr :: BBGr (Analysis a)
gr = forall a b. (Gr (BB a) () -> Gr (BB b) ()) -> BBGr a -> BBGr b
bbgrMap (Gr [Block (Analysis a)] () -> Gr [Block (Analysis a)] ()
fix forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
insEdges (forall a. BBState a -> [LEdge ()]
newEdges BBState (Analysis a)
bbs)) forall a b. (a -> b) -> a -> b
$ forall a. BBState a -> BBGr a
bbGraph BBState (Analysis a)
bbs
gr' :: BBGr (Analysis a)
gr' = BBGr (Analysis a)
gr { bbgrEntries :: [ASTExprNode]
bbgrEntries = [ASTExprNode
0], bbgrExits :: [ASTExprNode]
bbgrExits = [-ASTExprNode
1] }
pu' :: ProgramUnit (Analysis a)
pu' = forall (f :: * -> *) a. Annotated f => a -> f a -> f a
setAnnotation ((forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation ProgramUnit (Analysis a)
pu) { bBlocks :: Maybe (BBGr (Analysis a))
bBlocks = forall a. a -> Maybe a
Just BBGr (Analysis a)
gr' }) ProgramUnit (Analysis a)
pu
lm :: Map String ASTExprNode
lm = forall a. BBState a -> Map String ASTExprNode
labelMap BBState (Analysis a)
bbs
insEntryEdges :: (Data a, DynGraph gr) => ProgramUnit (Analysis a) -> gr [Block (Analysis a)] () -> gr [Block (Analysis a)] ()
insEntryEdges :: forall a (gr :: * -> * -> *).
(Data a, DynGraph gr) =>
ProgramUnit (Analysis a)
-> gr [Block (Analysis a)] () -> gr [Block (Analysis a)] ()
insEntryEdges ProgramUnit (Analysis a)
pu = forall (gr :: * -> * -> *) b a.
DynGraph gr =>
LEdge b -> gr a b -> gr a b
insEdge (ASTExprNode
0, ASTExprNode
1, ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode (ASTExprNode
0, [Block (Analysis a)]
bs)
where
bs :: [Block (Analysis a)]
bs = forall a.
Data a =>
ProgramUnit (Analysis a) -> Bool -> [Block (Analysis a)]
genInOutAssignments ProgramUnit (Analysis a)
pu Bool
False
genInOutAssignments :: Data a => ProgramUnit (Analysis a) -> Bool -> [Block (Analysis a)]
genInOutAssignments :: forall a.
Data a =>
ProgramUnit (Analysis a) -> Bool -> [Block (Analysis a)]
genInOutAssignments ProgramUnit (Analysis a)
pu Bool
exit
| Bool
exit, PUFunction{} <- ProgramUnit (Analysis a)
pu = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Expression (Analysis a) -> Integer -> Block (Analysis a)
genAssign (forall a.
Analysis a -> SrcSpan -> String -> Expression (Analysis a)
genVar Analysis a
a0 SrcSpan
noSrcSpan String
fnforall a. a -> [a] -> [a]
:[Expression (Analysis a)]
vs) [(Integer
0::Integer)..]
| Bool
otherwise = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Expression (Analysis a) -> Integer -> Block (Analysis a)
genAssign [Expression (Analysis a)]
vs [(Integer
1::Integer)..]
where
Named String
fn = forall a. ProgramUnit (Analysis a) -> ProgramUnitName
puName ProgramUnit (Analysis a)
pu
name :: Integer -> String
name Integer
i = String
fn forall a. [a] -> [a] -> [a]
++ String
"[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i forall a. [a] -> [a] -> [a]
++ String
"]"
a0 :: Analysis a
a0 = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall (b :: * -> *) a. Functor b => b a -> b (Analysis a)
initAnalysis [forall a. Analysis a -> a
prevAnnotation Analysis a
a]
(Analysis a
a, SrcSpan
s, [Expression (Analysis a)]
vs) = case ProgramUnit (Analysis a)
pu of
PUFunction Analysis a
_ SrcSpan
_ Maybe (TypeSpec (Analysis a))
_ PrefixSuffix (Analysis a)
_ String
_ (Just (AList Analysis a
a' SrcSpan
s' [Expression (Analysis a)]
vs')) Maybe (Expression (Analysis a))
_ [Block (Analysis a)]
_ Maybe [ProgramUnit (Analysis a)]
_ -> (Analysis a
a', SrcSpan
s', [Expression (Analysis a)]
vs')
PUSubroutine Analysis a
_ SrcSpan
_ PrefixSuffix (Analysis a)
_ String
_ (Just (AList Analysis a
a' SrcSpan
s' [Expression (Analysis a)]
vs')) [Block (Analysis a)]
_ Maybe [ProgramUnit (Analysis a)]
_ -> (Analysis a
a', SrcSpan
s', [Expression (Analysis a)]
vs')
PUFunction Analysis a
a' SrcSpan
s' Maybe (TypeSpec (Analysis a))
_ PrefixSuffix (Analysis a)
_ String
_ Maybe (AList Expression (Analysis a))
Nothing Maybe (Expression (Analysis a))
_ [Block (Analysis a)]
_ Maybe [ProgramUnit (Analysis a)]
_ -> (Analysis a
a', SrcSpan
s', [])
PUSubroutine Analysis a
a' SrcSpan
s' PrefixSuffix (Analysis a)
_ String
_ Maybe (AList Expression (Analysis a))
Nothing [Block (Analysis a)]
_ Maybe [ProgramUnit (Analysis a)]
_ -> (Analysis a
a', SrcSpan
s', [])
ProgramUnit (Analysis a)
_ -> (forall a. HasCallStack => String -> a
error String
"genInOutAssignments", forall a. HasCallStack => String -> a
error String
"genInOutAssignments", [])
genAssign :: Expression (Analysis a) -> Integer -> Block (Analysis a)
genAssign Expression (Analysis a)
v Integer
i = forall (f :: * -> *) a.
(Annotated f, Data (f (Analysis a)), Data a) =>
f (Analysis a) -> f (Analysis a)
analyseAllLhsVars1 forall a b. (a -> b) -> a -> b
$ forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
BlStatement Analysis a
a0 SrcSpan
s forall a. Maybe a
Nothing (forall a.
a -> SrcSpan -> Expression a -> Expression a -> Statement a
StExpressionAssign Analysis a
a0 SrcSpan
s Expression (Analysis a)
vl Expression (Analysis a)
vr)
where
(Expression (Analysis a)
vl, Expression (Analysis a)
vr) = if Bool
exit then (Expression (Analysis a)
v', Expression (Analysis a)
v) else (Expression (Analysis a)
v, Expression (Analysis a)
v')
v' :: Expression (Analysis a)
v' = case Expression (Analysis a)
v of
ExpValue Analysis a
_ SrcSpan
s' (ValVariable String
_) -> forall a.
Analysis a -> SrcSpan -> String -> Expression (Analysis a)
genVar Analysis a
a0 SrcSpan
s' (Integer -> String
name Integer
i)
Expression (Analysis a)
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"unhandled genAssign case: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall a b. a -> b -> a
const ()) Expression (Analysis a)
v)
delInvalidExits :: DynGraph gr => gr [Block a] b -> gr [Block a] b
delInvalidExits :: forall (gr :: * -> * -> *) a b.
DynGraph gr =>
gr [Block a] b -> gr [Block a] b
delInvalidExits gr [Block a] b
gr = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[(ASTExprNode, ASTExprNode)] -> gr a b -> gr a b
delEdges gr [Block a] b
gr forall a b. (a -> b) -> a -> b
$ do
ASTExprNode
n <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [ASTExprNode]
nodes gr [Block a] b
gr
[Block a]
bs <- forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> ASTExprNode -> Maybe a
lab gr [Block a] b
gr ASTExprNode
n
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall a. [Block a] -> Bool
isFinalBlockCtrlXfer [Block a]
bs
LEdge b
le <- forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> ASTExprNode -> [LEdge b]
out gr [Block a] b
gr ASTExprNode
n
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b. LEdge b -> (ASTExprNode, ASTExprNode)
toEdge LEdge b
le
insExitEdges :: (Data a, DynGraph gr) => ProgramUnit (Analysis a) -> M.Map String Node -> gr [Block (Analysis a)] () -> gr [Block (Analysis a)] ()
insExitEdges :: forall a (gr :: * -> * -> *).
(Data a, DynGraph gr) =>
ProgramUnit (Analysis a)
-> Map String ASTExprNode
-> gr [Block (Analysis a)] ()
-> gr [Block (Analysis a)] ()
insExitEdges ProgramUnit (Analysis a)
pu Map String ASTExprNode
lm gr [Block (Analysis a)] ()
gr = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
insEdges (forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode (-ASTExprNode
1, [Block (Analysis a)]
bs) gr [Block (Analysis a)] ()
gr) forall a b. (a -> b) -> a -> b
$ do
ASTExprNode
n <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [ASTExprNode]
nodes gr [Block (Analysis a)] ()
gr
[Block (Analysis a)]
bs' <- forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> ASTExprNode -> Maybe a
lab gr [Block (Analysis a)] ()
gr ASTExprNode
n
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> ASTExprNode -> [LEdge b]
out gr [Block (Analysis a)] ()
gr ASTExprNode
n) Bool -> Bool -> Bool
|| forall a. [Block a] -> Bool
isFinalBlockExceptionalCtrlXfer [Block (Analysis a)]
bs'
ASTExprNode
n' <- forall a1 a2. Num a1 => Map String a1 -> [Block a2] -> [a1]
examineFinalBlock Map String ASTExprNode
lm [Block (Analysis a)]
bs'
forall (m :: * -> *) a. Monad m => a -> m a
return (ASTExprNode
n, ASTExprNode
n', ())
where
bs :: [Block (Analysis a)]
bs = forall a.
Data a =>
ProgramUnit (Analysis a) -> Bool -> [Block (Analysis a)]
genInOutAssignments ProgramUnit (Analysis a)
pu Bool
True
getReadCtrlXfers :: [ControlPair a] -> (Maybe (Expression a), Maybe (Expression a))
getReadCtrlXfers :: forall a.
[ControlPair a] -> (Maybe (Expression a), Maybe (Expression a))
getReadCtrlXfers = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}.
(Maybe (Expression a), Maybe (Expression a))
-> ControlPair a -> (Maybe (Expression a), Maybe (Expression a))
handler (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
where
handler :: (Maybe (Expression a), Maybe (Expression a))
-> ControlPair a -> (Maybe (Expression a), Maybe (Expression a))
handler r :: (Maybe (Expression a), Maybe (Expression a))
r@(Maybe (Expression a)
r1, Maybe (Expression a)
r2) (ControlPair a
_ SrcSpan
_ Maybe String
ms Expression a
e) = case Maybe String
ms of
Maybe String
Nothing -> (Maybe (Expression a), Maybe (Expression a))
r
Just String
s ->
case forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s of
String
"end" -> (forall a. a -> Maybe a
Just Expression a
e, Maybe (Expression a)
r2)
String
"err" -> (Maybe (Expression a)
r1, forall a. a -> Maybe a
Just Expression a
e)
String
_ -> (Maybe (Expression a), Maybe (Expression a))
r
examineFinalBlock :: Num a1 => M.Map String a1 -> [Block a2] -> [a1]
examineFinalBlock :: forall a1 a2. Num a1 => Map String a1 -> [Block a2] -> [a1]
examineFinalBlock Map String a1
lm bs :: [Block a2]
bs@(Block a2
_:[Block a2]
_)
| BlStatement a2
_ SrcSpan
_ Maybe (Expression a2)
_ (StGotoUnconditional a2
_ SrcSpan
_ Expression a2
k) <- forall a. [a] -> a
last [Block a2]
bs = [forall a1 a2. Num a1 => Map String a1 -> Expression a2 -> a1
lookupBBlock Map String a1
lm Expression a2
k]
| BlStatement a2
_ SrcSpan
_ Maybe (Expression a2)
_ (StGotoAssigned a2
_ SrcSpan
_ Expression a2
_ Maybe (AList Expression a2)
ks) <- forall a. [a] -> a
last [Block a2]
bs = forall a b. (a -> b) -> [a] -> [b]
map (forall a1 a2. Num a1 => Map String a1 -> Expression a2 -> a1
lookupBBlock Map String a1
lm) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall (t :: * -> *) a. AList t a -> [t a]
aStrip Maybe (AList Expression a2)
ks)
| BlStatement a2
_ SrcSpan
_ Maybe (Expression a2)
_ (StGotoComputed a2
_ SrcSpan
_ AList Expression a2
ks Expression a2
_) <- forall a. [a] -> a
last [Block a2]
bs = forall a b. (a -> b) -> [a] -> [b]
map (forall a1 a2. Num a1 => Map String a1 -> Expression a2 -> a1
lookupBBlock Map String a1
lm) (forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Expression a2
ks)
| BlStatement a2
_ SrcSpan
_ Maybe (Expression a2)
_ StReturn{} <- forall a. [a] -> a
last [Block a2]
bs = [-a1
1]
| BlStatement a2
_ SrcSpan
_ Maybe (Expression a2)
_ (StIfArithmetic a2
_ SrcSpan
_ Expression a2
_ Expression a2
k1 Expression a2
k2 Expression a2
k3) <- forall a. [a] -> a
last [Block a2]
bs =
[forall a1 a2. Num a1 => Map String a1 -> Expression a2 -> a1
lookupBBlock Map String a1
lm Expression a2
k1, forall a1 a2. Num a1 => Map String a1 -> Expression a2 -> a1
lookupBBlock Map String a1
lm Expression a2
k2, forall a1 a2. Num a1 => Map String a1 -> Expression a2 -> a1
lookupBBlock Map String a1
lm Expression a2
k3]
| BlStatement a2
_ SrcSpan
_ Maybe (Expression a2)
_ (StRead a2
_ SrcSpan
_ AList ControlPair a2
cs Maybe (AList Expression a2)
_) <- forall a. [a] -> a
last [Block a2]
bs =
let (Maybe (Expression a2)
me, Maybe (Expression a2)
mr) = forall a.
[ControlPair a] -> (Maybe (Expression a), Maybe (Expression a))
getReadCtrlXfers forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList ControlPair a2
cs
f :: Maybe (Expression a2) -> [a1]
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a b. (a -> b) -> a -> b
$ \Expression a2
v -> [forall a1 a2. Num a1 => Map String a1 -> Expression a2 -> a1
lookupBBlock Map String a1
lm Expression a2
v]
in Maybe (Expression a2) -> [a1]
f Maybe (Expression a2)
me forall a. [a] -> [a] -> [a]
++ Maybe (Expression a2) -> [a1]
f Maybe (Expression a2)
mr
examineFinalBlock Map String a1
_ [Block a2]
_ = [-a1
1]
isFinalBlockCtrlXfer :: [Block a] -> Bool
isFinalBlockCtrlXfer :: forall a. [Block a] -> Bool
isFinalBlockCtrlXfer bs :: [Block a]
bs@(Block a
_:[Block a]
_)
| BlStatement a
_ SrcSpan
_ Maybe (Expression a)
_ StGotoUnconditional{} <- forall a. [a] -> a
last [Block a]
bs = Bool
True
| BlStatement a
_ SrcSpan
_ Maybe (Expression a)
_ StGotoAssigned{} <- forall a. [a] -> a
last [Block a]
bs = Bool
True
| BlStatement a
_ SrcSpan
_ Maybe (Expression a)
_ StReturn{} <- forall a. [a] -> a
last [Block a]
bs = Bool
True
| BlStatement a
_ SrcSpan
_ Maybe (Expression a)
_ StIfArithmetic{} <- forall a. [a] -> a
last [Block a]
bs = Bool
True
isFinalBlockCtrlXfer [Block a]
_ = Bool
False
isFinalBlockExceptionalCtrlXfer :: [Block a] -> Bool
isFinalBlockExceptionalCtrlXfer :: forall a. [Block a] -> Bool
isFinalBlockExceptionalCtrlXfer bs :: [Block a]
bs@(Block a
_:[Block a]
_)
| BlStatement a
_ SrcSpan
_ Maybe (Expression a)
_ StGotoComputed{} <- forall a. [a] -> a
last [Block a]
bs = Bool
True
| BlStatement a
_ SrcSpan
_ Maybe (Expression a)
_ StRead{} <- forall a. [a] -> a
last [Block a]
bs = Bool
True
isFinalBlockExceptionalCtrlXfer [Block a]
_ = Bool
False
dropLeadingZeroes :: String -> String
dropLeadingZeroes :: String -> String
dropLeadingZeroes = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'0')
lookupBBlock :: Num a1 => M.Map String a1 -> Expression a2 -> a1
lookupBBlock :: forall a1 a2. Num a1 => Map String a1 -> Expression a2 -> a1
lookupBBlock Map String a1
lm Expression a2
a =
case Expression a2
a of
ExpValue a2
_ SrcSpan
_ (ValInteger String
l Maybe (KindParam a2)
_) -> (-a1
1) forall a. a -> Maybe a -> a
`fromMaybe` forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> String
dropLeadingZeroes String
l) Map String a1
lm
ExpValue a2
_ SrcSpan
_ (ValVariable String
l) -> (-a1
1) forall a. a -> Maybe a -> a
`fromMaybe` forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
l Map String a1
lm
Expression a2
_ -> forall a. HasCallStack => String -> a
error String
"unhandled lookupBBlock"
delEmptyBBlocks :: (Foldable t, DynGraph gr) => gr (t a) b -> gr (t a) b
delEmptyBBlocks :: forall (t :: * -> *) (gr :: * -> * -> *) a b.
(Foldable t, DynGraph gr) =>
gr (t a) b -> gr (t a) b
delEmptyBBlocks gr (t a) b
gr
| (ASTExprNode
n, ASTExprNode
s, ASTExprNode
t, b
l):[(ASTExprNode, ASTExprNode, ASTExprNode, b)]
_ <- [(ASTExprNode, ASTExprNode, ASTExprNode, b)]
candidates = forall (t :: * -> *) (gr :: * -> * -> *) a b.
(Foldable t, DynGraph gr) =>
gr (t a) b -> gr (t a) b
delEmptyBBlocks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) b a.
DynGraph gr =>
LEdge b -> gr a b -> gr a b
insEdge (ASTExprNode
s, ASTExprNode
t, b
l) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b.
Graph gr =>
ASTExprNode -> gr a b -> gr a b
delNode ASTExprNode
n forall a b. (a -> b) -> a -> b
$ gr (t a) b
gr
| Bool
otherwise = gr (t a) b
gr
where
candidates :: [(ASTExprNode, ASTExprNode, ASTExprNode, b)]
candidates = do
let emptyBBs :: [(ASTExprNode, t a)]
emptyBBs = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes gr (t a) b
gr)
let adjs :: [(ASTExprNode, [LEdge b], [LEdge b])]
adjs = forall a b. (a -> b) -> [a] -> [b]
map (\ (ASTExprNode
n, t a
_) -> (ASTExprNode
n, forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> ASTExprNode -> [LEdge b]
inn gr (t a) b
gr ASTExprNode
n, forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> ASTExprNode -> [LEdge b]
out gr (t a) b
gr ASTExprNode
n)) [(ASTExprNode, t a)]
emptyBBs
(ASTExprNode
n, [(ASTExprNode
s,ASTExprNode
_,b
l)], [(ASTExprNode
_,ASTExprNode
t,b
_)]) <- [(ASTExprNode, [LEdge b], [LEdge b])]
adjs
forall (m :: * -> *) a. Monad m => a -> m a
return (ASTExprNode
n, ASTExprNode
s, ASTExprNode
t, b
l)
delUnreachable :: DynGraph gr => gr a b -> gr a b
delUnreachable :: forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> gr a b
delUnreachable gr a b
gr = forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[ASTExprNode] -> gr a b -> gr a b
subgraph (forall (gr :: * -> * -> *) a b.
Graph gr =>
ASTExprNode -> gr a b -> [ASTExprNode]
reachable ASTExprNode
0 gr a b
gr) gr a b
gr
data BBState a = BBS { forall a. BBState a -> BBGr a
bbGraph :: BBGr a
, forall a. BBState a -> BB a
curBB :: BB a
, forall a. BBState a -> ASTExprNode
curNode :: Node
, forall a. BBState a -> Map String ASTExprNode
labelMap :: M.Map String Node
, forall a. BBState a -> [ASTExprNode]
nums :: [Int]
, forall a. BBState a -> [ASTExprNode]
tempNums :: [Int]
, forall a. BBState a -> [LEdge ()]
newEdges :: [LEdge ()] }
bbs0 :: BBState a
bbs0 :: forall a. BBState a
bbs0 = BBS { bbGraph :: BBGr a
bbGraph = forall a. BBGr a
bbgrEmpty, curBB :: BB a
curBB = [], curNode :: ASTExprNode
curNode = ASTExprNode
1
, labelMap :: Map String ASTExprNode
labelMap = forall k a. Map k a
M.empty, nums :: [ASTExprNode]
nums = [ASTExprNode
2..], tempNums :: [ASTExprNode]
tempNums = [ASTExprNode
0..]
, newEdges :: [LEdge ()]
newEdges = [] }
type BBlocker a = State (BBState a)
execBBlocker :: BBlocker a b -> BBState a
execBBlocker :: forall a b. BBlocker a b -> BBState a
execBBlocker = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState forall a. BBState a
bbs0
processBlocks :: Data a => [Block (Analysis a)] -> BBlocker (Analysis a) (Node, Node)
processBlocks :: forall a.
Data a =>
[Block (Analysis a)]
-> BBlocker (Analysis a) (ASTExprNode, ASTExprNode)
processBlocks [Block (Analysis a)]
bs = do
ASTExprNode
startN <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. BBState a -> ASTExprNode
curNode
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Data a => Block (Analysis a) -> BBlocker (Analysis a) ()
perBlock [Block (Analysis a)]
bs
ASTExprNode
endN <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. BBState a -> ASTExprNode
curNode
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ BBState (Analysis a)
st -> BBState (Analysis a)
st { bbGraph :: BBGr (Analysis a)
bbGraph = forall a b. (Gr (BB a) () -> Gr (BB b) ()) -> BBGr a -> BBGr b
bbgrMap (forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode (ASTExprNode
endN, forall a. [a] -> [a]
reverse (forall a. BBState a -> BB a
curBB BBState (Analysis a)
st))) (forall a. BBState a -> BBGr a
bbGraph BBState (Analysis a)
st)
, curBB :: [Block (Analysis a)]
curBB = [] }
forall (m :: * -> *) a. Monad m => a -> m a
return (ASTExprNode
startN, ASTExprNode
endN)
msnoc :: Maybe a -> [a] -> [a]
msnoc :: forall a. Maybe a -> [a] -> [a]
msnoc Maybe a
Nothing [a]
xs = [a]
xs
msnoc (Just a
x) [a]
xs = [a]
xs forall a. Semigroup a => a -> a -> a
<> [a
x]
perBlock :: Data a => Block (Analysis a) -> BBlocker (Analysis a) ()
perBlock :: forall a. Data a => Block (Analysis a) -> BBlocker (Analysis a) ()
perBlock b :: Block (Analysis a)
b@(BlIf Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ Maybe String
_ NonEmpty (Expression (Analysis a), [Block (Analysis a)])
clauses Maybe [Block (Analysis a)]
elseBlock Maybe (Expression (Analysis a))
_) = do
forall a. Block a -> BBlocker a ()
processLabel Block (Analysis a)
b
NonEmpty (Expression (Analysis a))
_ <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst NonEmpty (Expression (Analysis a), [Block (Analysis a)])
clauses) forall a.
Data a =>
Expression (Analysis a)
-> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCalls
forall a. Block a -> BBlocker a ()
addToBBlock forall a b. (a -> b) -> a -> b
$ forall a. Block a -> Block a
stripNestedBlocks Block (Analysis a)
b
(ASTExprNode
ifN, ASTExprNode
_) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
let bss :: [[Block (Analysis a)]]
bss = forall a. Maybe a -> [a] -> [a]
msnoc Maybe [Block (Analysis a)]
elseBlock forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Expression (Analysis a), [Block (Analysis a)])
clauses
[(ASTExprNode, ASTExprNode)]
startEnds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Block (Analysis a)]]
bss forall a b. (a -> b) -> a -> b
$ \ [Block (Analysis a)]
bs -> do
(ASTExprNode
thenN, ASTExprNode
endN) <- forall a.
Data a =>
[Block (Analysis a)]
-> BBlocker (Analysis a) (ASTExprNode, ASTExprNode)
processBlocks [Block (Analysis a)]
bs
ASTExprNode
_ <- forall a. BBlocker a ASTExprNode
genBBlock
forall (m :: * -> *) a. Monad m => a -> m a
return (ASTExprNode
thenN, ASTExprNode
endN)
ASTExprNode
nxtN <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. BBState a -> ASTExprNode
curNode
let es :: [LEdge ()]
es = [(ASTExprNode, ASTExprNode)]
startEnds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (ASTExprNode
thenN, ASTExprNode
endN) -> [(ASTExprNode
ifN, ASTExprNode
thenN, ()), (ASTExprNode
endN, ASTExprNode
nxtN, ())]
forall a (m :: * -> *).
MonadState (BBState a) m =>
[LEdge ()] -> m ()
createEdges forall a b. (a -> b) -> a -> b
$ case Maybe [Block (Analysis a)]
elseBlock of Maybe [Block (Analysis a)]
Nothing -> (ASTExprNode
ifN, ASTExprNode
nxtN, ())forall a. a -> [a] -> [a]
:[LEdge ()]
es
Just{} -> [LEdge ()]
es
perBlock b :: Block (Analysis a)
b@(BlCase Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ Maybe String
_ Expression (Analysis a)
_ [(AList Index (Analysis a), [Block (Analysis a)])]
clauses Maybe [Block (Analysis a)]
defCase Maybe (Expression (Analysis a))
_) = do
forall a. Block a -> BBlocker a ()
processLabel Block (Analysis a)
b
forall a. Block a -> BBlocker a ()
addToBBlock forall a b. (a -> b) -> a -> b
$ forall a. Block a -> Block a
stripNestedBlocks Block (Analysis a)
b
(ASTExprNode
selectN, ASTExprNode
_) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
let bss :: [[Block (Analysis a)]]
bss = forall a. Maybe a -> [a] -> [a]
msnoc Maybe [Block (Analysis a)]
defCase forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(AList Index (Analysis a), [Block (Analysis a)])]
clauses
[(ASTExprNode, ASTExprNode)]
startEnds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Block (Analysis a)]]
bss forall a b. (a -> b) -> a -> b
$ \ [Block (Analysis a)]
bs -> do
(ASTExprNode
caseN, ASTExprNode
endN) <- forall a.
Data a =>
[Block (Analysis a)]
-> BBlocker (Analysis a) (ASTExprNode, ASTExprNode)
processBlocks [Block (Analysis a)]
bs
ASTExprNode
_ <- forall a. BBlocker a ASTExprNode
genBBlock
forall (m :: * -> *) a. Monad m => a -> m a
return (ASTExprNode
caseN, ASTExprNode
endN)
ASTExprNode
nxtN <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. BBState a -> ASTExprNode
curNode
let es :: [LEdge ()]
es = [(ASTExprNode, ASTExprNode)]
startEnds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (ASTExprNode
caseN, ASTExprNode
endN) -> [(ASTExprNode
selectN, ASTExprNode
caseN, ()), (ASTExprNode
endN, ASTExprNode
nxtN, ())]
forall a (m :: * -> *).
MonadState (BBState a) m =>
[LEdge ()] -> m ()
createEdges forall a b. (a -> b) -> a -> b
$ case Maybe [Block (Analysis a)]
defCase of Maybe [Block (Analysis a)]
Nothing -> (ASTExprNode
selectN, ASTExprNode
nxtN, ())forall a. a -> [a] -> [a]
:[LEdge ()]
es
Just{} -> [LEdge ()]
es
perBlock b :: Block (Analysis a)
b@(BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ (StGotoComputed Analysis a
_ SrcSpan
_ AList Expression (Analysis a)
_ Expression (Analysis a)
exp)) = do
forall a. Block a -> BBlocker a ()
processLabel Block (Analysis a)
b
Expression (Analysis a)
_ <- forall a.
Data a =>
Expression (Analysis a)
-> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCalls Expression (Analysis a)
exp
forall a. Block a -> BBlocker a ()
addToBBlock Block (Analysis a)
b
(ASTExprNode
gotoN, ASTExprNode
nxtN) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
forall a (m :: * -> *).
MonadState (BBState a) m =>
[LEdge ()] -> m ()
createEdges [(ASTExprNode
gotoN, ASTExprNode
nxtN, ())]
perBlock b :: Block (Analysis a)
b@(BlStatement Analysis a
a SrcSpan
ss Maybe (Expression (Analysis a))
_ (StIfLogical Analysis a
_ SrcSpan
_ Expression (Analysis a)
exp Statement (Analysis a)
stm)) = do
forall a. Block a -> BBlocker a ()
processLabel Block (Analysis a)
b
Expression (Analysis a)
_ <- forall a.
Data a =>
Expression (Analysis a)
-> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCalls Expression (Analysis a)
exp
forall a. Block a -> BBlocker a ()
addToBBlock forall a b. (a -> b) -> a -> b
$ forall a. Block a -> Block a
stripNestedBlocks Block (Analysis a)
b
(ASTExprNode
ifN, ASTExprNode
thenN) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
(ASTExprNode, ASTExprNode)
_ <- forall a.
Data a =>
[Block (Analysis a)]
-> BBlocker (Analysis a) (ASTExprNode, ASTExprNode)
processBlocks [forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
BlStatement Analysis a
a{ insLabel :: Maybe ASTExprNode
insLabel = forall a. Maybe a
Nothing } SrcSpan
ss forall a. Maybe a
Nothing Statement (Analysis a)
stm]
ASTExprNode
_ <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. BBState a -> ASTExprNode
curNode
ASTExprNode
nxtN <- forall a. BBlocker a ASTExprNode
genBBlock
forall a (m :: * -> *).
MonadState (BBState a) m =>
[LEdge ()] -> m ()
createEdges [(ASTExprNode
ifN, ASTExprNode
thenN, ()), (ASTExprNode
ifN, ASTExprNode
nxtN, ()), (ASTExprNode
thenN, ASTExprNode
nxtN, ())]
perBlock b :: Block (Analysis a)
b@(BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ StIfArithmetic{}) =
forall a. Block a -> BBlocker a ()
processLabel Block (Analysis a)
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Block a -> BBlocker a ()
addToBBlock Block (Analysis a)
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. StateT (BBState a) Identity ()
closeBBlock_
perBlock b :: Block (Analysis a)
b@(BlDo Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ Maybe String
_ Maybe (Expression (Analysis a))
_ (Just DoSpecification (Analysis a)
spec) [Block (Analysis a)]
bs Maybe (Expression (Analysis a))
_) = do
let DoSpecification Analysis a
_ SrcSpan
_ (StExpressionAssign Analysis a
_ SrcSpan
_ Expression (Analysis a)
_ Expression (Analysis a)
e1) Expression (Analysis a)
e2 Maybe (Expression (Analysis a))
me3 = DoSpecification (Analysis a)
spec
Expression (Analysis a)
_ <- forall a.
Data a =>
Expression (Analysis a)
-> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCalls Expression (Analysis a)
e1
Expression (Analysis a)
_ <- forall a.
Data a =>
Expression (Analysis a)
-> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCalls Expression (Analysis a)
e2
Maybe (Expression (Analysis a))
_ <- case Maybe (Expression (Analysis a))
me3 of Just Expression (Analysis a)
e3 -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a.
Data a =>
Expression (Analysis a)
-> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCalls Expression (Analysis a)
e3; Maybe (Expression (Analysis a))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
forall a.
Data a =>
Maybe (Expression (Analysis a))
-> Block (Analysis a)
-> [Block (Analysis a)]
-> BBlocker (Analysis a) ()
perDoBlock forall a. Maybe a
Nothing Block (Analysis a)
b [Block (Analysis a)]
bs
perBlock b :: Block (Analysis a)
b@(BlDo Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ Maybe String
_ Maybe (Expression (Analysis a))
_ Maybe (DoSpecification (Analysis a))
Nothing [Block (Analysis a)]
bs Maybe (Expression (Analysis a))
_) = forall a.
Data a =>
Maybe (Expression (Analysis a))
-> Block (Analysis a)
-> [Block (Analysis a)]
-> BBlocker (Analysis a) ()
perDoBlock forall a. Maybe a
Nothing Block (Analysis a)
b [Block (Analysis a)]
bs
perBlock b :: Block (Analysis a)
b@(BlDoWhile Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ Maybe String
_ Maybe (Expression (Analysis a))
_ Expression (Analysis a)
exp [Block (Analysis a)]
bs Maybe (Expression (Analysis a))
_) = forall a.
Data a =>
Maybe (Expression (Analysis a))
-> Block (Analysis a)
-> [Block (Analysis a)]
-> BBlocker (Analysis a) ()
perDoBlock (forall a. a -> Maybe a
Just Expression (Analysis a)
exp) Block (Analysis a)
b [Block (Analysis a)]
bs
perBlock b :: Block (Analysis a)
b@(BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ StReturn{}) =
forall a. Block a -> BBlocker a ()
processLabel Block (Analysis a)
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Block a -> BBlocker a ()
addToBBlock Block (Analysis a)
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. StateT (BBState a) Identity ()
closeBBlock_
perBlock b :: Block (Analysis a)
b@(BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ StGotoUnconditional{}) =
forall a. Block a -> BBlocker a ()
processLabel Block (Analysis a)
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Block a -> BBlocker a ()
addToBBlock Block (Analysis a)
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. StateT (BBState a) Identity ()
closeBBlock_
perBlock b' :: Block (Analysis a)
b'@(BlStatement Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l (StCall Analysis a
a' SrcSpan
s' cn :: Expression (Analysis a)
cn@ExpValue{} AList Argument (Analysis a)
aargs)) = do
case forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Argument (Analysis a)
aargs of
[] -> do
(ASTExprNode
prevN, ASTExprNode
callN) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
forall a. Block a -> BBlocker a ()
addToBBlock Block (Analysis a)
b'
(ASTExprNode
_, ASTExprNode
nextN) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
forall a (m :: * -> *).
MonadState (BBState a) m =>
[LEdge ()] -> m ()
createEdges [ (ASTExprNode
prevN, ASTExprNode
callN, ()), (ASTExprNode
callN, ASTExprNode
nextN, ()) ]
Argument (Analysis a)
_:[Argument (Analysis a)]
_ -> do
let a0 :: Analysis a
a0 = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) a. Functor b => b a -> b (Analysis a)
initAnalysis forall a b. (a -> b) -> a -> b
$ [forall a. Analysis a -> a
prevAnnotation Analysis a
a]
let exps :: [Expression (Analysis a)]
exps = forall a b. (a -> b) -> [a] -> [b]
map forall a. Argument a -> Expression a
argExtractExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. AList t a -> [t a]
aStrip forall a b. (a -> b) -> a -> b
$ AList Argument (Analysis a)
aargs
(ASTExprNode
prevN, ASTExprNode
formalN) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
case Maybe (Expression (Analysis a))
l of
Just (ExpValue Analysis a
_ SrcSpan
_ (ValInteger String
l' Maybe (KindParam (Analysis a))
_)) -> forall a (m :: * -> *).
MonadState (BBState a) m =>
String -> ASTExprNode -> m ()
insertLabel String
l' ASTExprNode
formalN
Maybe (Expression (Analysis a))
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
let name :: Integer -> String
name Integer
i = forall a. Expression (Analysis a) -> String
varName Expression (Analysis a)
cn forall a. [a] -> [a] -> [a]
++ String
"[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i forall a. [a] -> [a] -> [a]
++ String
"]"
let formal :: Expression (Analysis a) -> Integer -> Expression (Analysis a)
formal (ExpValue Analysis a
a'' SrcSpan
s'' (ValVariable String
_)) Integer
i = forall a.
Analysis a -> SrcSpan -> String -> Expression (Analysis a)
genVar Analysis a
a''{ insLabel :: Maybe ASTExprNode
insLabel = forall a. Maybe a
Nothing } SrcSpan
s'' (Integer -> String
name Integer
i)
formal Expression (Analysis a)
e Integer
i = forall a.
Analysis a -> SrcSpan -> String -> Expression (Analysis a)
genVar Analysis a
a''{ insLabel :: Maybe ASTExprNode
insLabel = forall a. Maybe a
Nothing } SrcSpan
s'' (Integer -> String
name Integer
i)
where a'' :: Analysis a
a'' = forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
e; s'' :: SrcSpan
s'' = forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
e
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Expression (Analysis a)]
exps [(Integer
1::Integer)..]) forall a b. (a -> b) -> a -> b
$ \ (Expression (Analysis a)
e, Integer
i) -> do
Expression (Analysis a)
e' <- forall a.
Data a =>
Expression (Analysis a)
-> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCalls Expression (Analysis a)
e
let b :: Block (Analysis a)
b = forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
BlStatement Analysis a
a{ insLabel :: Maybe ASTExprNode
insLabel = forall a. Maybe a
Nothing } SrcSpan
s Maybe (Expression (Analysis a))
l (forall a.
a -> SrcSpan -> Expression a -> Expression a -> Statement a
StExpressionAssign Analysis a
a' SrcSpan
s' (Expression (Analysis a) -> Integer -> Expression (Analysis a)
formal Expression (Analysis a)
e' Integer
i) Expression (Analysis a)
e')
forall a. Block a -> BBlocker a ()
addToBBlock forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a.
(Annotated f, Data (f (Analysis a)), Data a) =>
f (Analysis a) -> f (Analysis a)
analyseAllLhsVars1 Block (Analysis a)
b
(ASTExprNode
formalN', ASTExprNode
dummyCallN) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
let dummyArgs :: [Argument (Analysis a)]
dummyArgs = forall a b. (a -> b) -> [a] -> [b]
map (\Expression (Analysis a)
e -> forall a.
a -> SrcSpan -> Maybe String -> ArgumentExpression a -> Argument a
Argument Analysis a
a0 SrcSpan
s' forall a. Maybe a
Nothing (forall a. Expression a -> ArgumentExpression a
ArgExpr Expression (Analysis a)
e))
(forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Expression (Analysis a) -> Integer -> Expression (Analysis a)
formal [Expression (Analysis a)]
exps [(Integer
1::Integer)..])
forall a. Block a -> BBlocker a ()
addToBBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
(Annotated f, Data (f (Analysis a)), Data a) =>
f (Analysis a) -> f (Analysis a)
analyseAllLhsVars1 forall a b. (a -> b) -> a -> b
$ forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
BlStatement Analysis a
a SrcSpan
s forall a. Maybe a
Nothing (forall a.
a -> SrcSpan -> Expression a -> AList Argument a -> Statement a
StCall Analysis a
a' SrcSpan
s' Expression (Analysis a)
cn (forall (t :: * -> *) a. Spanned (t a) => a -> [t a] -> AList t a
fromList Analysis a
a0 [Argument (Analysis a)]
dummyArgs))
(ASTExprNode
_, ASTExprNode
returnedN) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Expression (Analysis a)]
exps [(Integer
1::Integer)..]) forall a b. (a -> b) -> a -> b
$ \ (Expression (Analysis a)
e, Integer
i) ->
(forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Expression a -> Bool
isLExpr Expression (Analysis a)
e) forall a b. (a -> b) -> a -> b
$
forall a. Block a -> BBlocker a ()
addToBBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
(Annotated f, Data (f (Analysis a)), Data a) =>
f (Analysis a) -> f (Analysis a)
analyseAllLhsVars1 forall a b. (a -> b) -> a -> b
$
forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
BlStatement Analysis a
a{ insLabel :: Maybe ASTExprNode
insLabel = forall a. Maybe a
Nothing } SrcSpan
s Maybe (Expression (Analysis a))
l (forall a.
a -> SrcSpan -> Expression a -> Expression a -> Statement a
StExpressionAssign Analysis a
a' SrcSpan
s' Expression (Analysis a)
e (Expression (Analysis a) -> Integer -> Expression (Analysis a)
formal Expression (Analysis a)
e Integer
i)))
(ASTExprNode
_, ASTExprNode
nextN) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
forall a (m :: * -> *).
MonadState (BBState a) m =>
[LEdge ()] -> m ()
createEdges [ (ASTExprNode
prevN, ASTExprNode
formalN, ()), (ASTExprNode
formalN', ASTExprNode
dummyCallN, ())
, (ASTExprNode
dummyCallN, ASTExprNode
returnedN, ()), (ASTExprNode
returnedN, ASTExprNode
nextN, ()) ]
perBlock b :: Block (Analysis a)
b@(BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ (StRead Analysis a
_ SrcSpan
_ AList ControlPair (Analysis a)
cs Maybe (AList Expression (Analysis a))
_)) = do
let (Maybe (Expression (Analysis a))
end, Maybe (Expression (Analysis a))
err) = forall a.
[ControlPair a] -> (Maybe (Expression a), Maybe (Expression a))
getReadCtrlXfers forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList ControlPair (Analysis a)
cs
forall a. Block a -> BBlocker a ()
processLabel Block (Analysis a)
b
Block (Analysis a)
b' <- forall from to (m :: * -> *).
(Biplate from to, Applicative m) =>
(to -> m to) -> from -> m from
descendBiM forall a.
Data a =>
Expression (Analysis a)
-> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCalls Block (Analysis a)
b
forall a. Block a -> BBlocker a ()
addToBBlock Block (Analysis a)
b'
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe (Expression (Analysis a))
end Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (Expression (Analysis a))
err) forall a b. (a -> b) -> a -> b
$ do
(ASTExprNode
readN, ASTExprNode
nxtN) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
forall a (m :: * -> *).
MonadState (BBState a) m =>
[LEdge ()] -> m ()
createEdges [(ASTExprNode
readN, ASTExprNode
nxtN, ())]
perBlock Block (Analysis a)
b = do
forall a. Block a -> BBlocker a ()
processLabel Block (Analysis a)
b
Block (Analysis a)
b' <- forall from to (m :: * -> *).
(Biplate from to, Applicative m) =>
(to -> m to) -> from -> m from
descendBiM forall a.
Data a =>
Expression (Analysis a)
-> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCalls Block (Analysis a)
b
forall a. Block a -> BBlocker a ()
addToBBlock Block (Analysis a)
b'
perDoBlock :: Data a => Maybe (Expression (Analysis a)) -> Block (Analysis a) -> [Block (Analysis a)] -> BBlocker (Analysis a) ()
perDoBlock :: forall a.
Data a =>
Maybe (Expression (Analysis a))
-> Block (Analysis a)
-> [Block (Analysis a)]
-> BBlocker (Analysis a) ()
perDoBlock Maybe (Expression (Analysis a))
repeatExpr Block (Analysis a)
b [Block (Analysis a)]
bs = do
(ASTExprNode
n, ASTExprNode
doN) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
case forall (f :: * -> *) a. Labeled f => f a -> Maybe (Expression a)
getLabel Block (Analysis a)
b of
Just (ExpValue Analysis a
_ SrcSpan
_ (ValInteger String
l Maybe (KindParam (Analysis a))
_)) -> forall a (m :: * -> *).
MonadState (BBState a) m =>
String -> ASTExprNode -> m ()
insertLabel String
l ASTExprNode
doN
Maybe (Expression (Analysis a))
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
case Maybe (Expression (Analysis a))
repeatExpr of Just Expression (Analysis a)
e -> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall a.
Data a =>
Expression (Analysis a)
-> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCalls Expression (Analysis a)
e); Maybe (Expression (Analysis a))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall a. Block a -> BBlocker a ()
addToBBlock forall a b. (a -> b) -> a -> b
$ forall a. Block a -> Block a
stripNestedBlocks Block (Analysis a)
b
(ASTExprNode, ASTExprNode)
_ <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
(ASTExprNode
startN, ASTExprNode
endN) <- forall a.
Data a =>
[Block (Analysis a)]
-> BBlocker (Analysis a) (ASTExprNode, ASTExprNode)
processBlocks [Block (Analysis a)]
bs
ASTExprNode
n' <- forall a. BBlocker a ASTExprNode
genBBlock
forall a (m :: * -> *).
MonadState (BBState a) m =>
[LEdge ()] -> m ()
createEdges [(ASTExprNode
n, ASTExprNode
doN, ()), (ASTExprNode
doN, ASTExprNode
n', ()), (ASTExprNode
doN, ASTExprNode
startN, ()), (ASTExprNode
endN, ASTExprNode
doN, ())]
processLabel :: Block a -> BBlocker a ()
processLabel :: forall a. Block a -> BBlocker a ()
processLabel Block a
b | Just (ExpValue a
_ SrcSpan
_ (ValInteger String
l Maybe (KindParam a)
_)) <- forall (f :: * -> *) a. Labeled f => f a -> Maybe (Expression a)
getLabel Block a
b = do
(ASTExprNode
n, ASTExprNode
n') <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
forall a (m :: * -> *).
MonadState (BBState a) m =>
String -> ASTExprNode -> m ()
insertLabel String
l ASTExprNode
n'
forall a (m :: * -> *).
MonadState (BBState a) m =>
[LEdge ()] -> m ()
createEdges [(ASTExprNode
n, ASTExprNode
n', ())]
processLabel Block a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
insertLabel :: MonadState (BBState a) m => String -> Node -> m ()
insertLabel :: forall a (m :: * -> *).
MonadState (BBState a) m =>
String -> ASTExprNode -> m ()
insertLabel String
l ASTExprNode
n = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ BBState a
st -> BBState a
st { labelMap :: Map String ASTExprNode
labelMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (String -> String
dropLeadingZeroes String
l) ASTExprNode
n (forall a. BBState a -> Map String ASTExprNode
labelMap BBState a
st) }
addToBBlock :: Block a -> BBlocker a ()
addToBBlock :: forall a. Block a -> BBlocker a ()
addToBBlock Block a
b = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ BBState a
st -> BBState a
st { curBB :: BB a
curBB = Block a
bforall a. a -> [a] -> [a]
:forall a. BBState a -> BB a
curBB BBState a
st }
closeBBlock :: BBlocker a (Node, Node)
closeBBlock :: forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock = do
ASTExprNode
n <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. BBState a -> ASTExprNode
curNode
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ BBState a
st -> BBState a
st { bbGraph :: BBGr a
bbGraph = forall a b. (Gr (BB a) () -> Gr (BB b) ()) -> BBGr a -> BBGr b
bbgrMap (forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode (ASTExprNode
n, forall a. [a] -> [a]
reverse (forall a. BBState a -> BB a
curBB BBState a
st))) (forall a. BBState a -> BBGr a
bbGraph BBState a
st), curBB :: BB a
curBB = [] }
ASTExprNode
n' <- forall a. BBlocker a ASTExprNode
genBBlock
forall (m :: * -> *) a. Monad m => a -> m a
return (ASTExprNode
n, ASTExprNode
n')
closeBBlock_ :: StateT (BBState a) Identity ()
closeBBlock_ :: forall a. StateT (BBState a) Identity ()
closeBBlock_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
genBBlock :: BBlocker a Int
genBBlock :: forall a. BBlocker a ASTExprNode
genBBlock = do
ASTExprNode
n' <- forall a. BBlocker a ASTExprNode
gen
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ BBState a
st -> BBState a
st { curNode :: ASTExprNode
curNode = ASTExprNode
n', curBB :: BB a
curBB = [] }
forall (m :: * -> *) a. Monad m => a -> m a
return ASTExprNode
n'
createEdges :: MonadState (BBState a) m => [LEdge ()] -> m ()
createEdges :: forall a (m :: * -> *).
MonadState (BBState a) m =>
[LEdge ()] -> m ()
createEdges [LEdge ()]
es = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ BBState a
st -> BBState a
st { newEdges :: [LEdge ()]
newEdges = [LEdge ()]
es forall a. [a] -> [a] -> [a]
++ forall a. BBState a -> [LEdge ()]
newEdges BBState a
st }
gen :: BBlocker a Int
gen :: forall a. BBlocker a ASTExprNode
gen = do
~(ASTExprNode
n:[ASTExprNode]
ns) <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. BBState a -> [ASTExprNode]
nums
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ BBState a
s -> BBState a
s { nums :: [ASTExprNode]
nums = [ASTExprNode]
ns }
forall (m :: * -> *) a. Monad m => a -> m a
return ASTExprNode
n
genTemp :: String -> BBlocker a String
genTemp :: forall a. String -> BBlocker a String
genTemp String
str = do
~(ASTExprNode
n:[ASTExprNode]
ns) <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. BBState a -> [ASTExprNode]
tempNums
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ BBState a
s -> BBState a
s { tempNums :: [ASTExprNode]
tempNums = [ASTExprNode]
ns }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"_" forall a. [a] -> [a] -> [a]
++ String
str forall a. [a] -> [a] -> [a]
++ String
"_t#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ASTExprNode
n
stripNestedBlocks :: Block a -> Block a
stripNestedBlocks :: forall a. Block a -> Block a
stripNestedBlocks (BlDo a
a SrcSpan
s Maybe (Expression a)
l Maybe String
mn Maybe (Expression a)
tl Maybe (DoSpecification a)
ds [Block a]
_ Maybe (Expression a)
el) = forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe String
-> Maybe (Expression a)
-> Maybe (DoSpecification a)
-> [Block a]
-> Maybe (Expression a)
-> Block a
BlDo a
a SrcSpan
s Maybe (Expression a)
l Maybe String
mn Maybe (Expression a)
tl Maybe (DoSpecification a)
ds [] Maybe (Expression a)
el
stripNestedBlocks (BlDoWhile a
a SrcSpan
s Maybe (Expression a)
l Maybe String
tl Maybe (Expression a)
n Expression a
e [Block a]
_ Maybe (Expression a)
el) = forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe String
-> Maybe (Expression a)
-> Expression a
-> [Block a]
-> Maybe (Expression a)
-> Block a
BlDoWhile a
a SrcSpan
s Maybe (Expression a)
l Maybe String
tl Maybe (Expression a)
n Expression a
e [] Maybe (Expression a)
el
stripNestedBlocks (BlIf a
a SrcSpan
s Maybe (Expression a)
l Maybe String
mn NonEmpty (Expression a, [Block a])
clauses Maybe [Block a]
elseBlock Maybe (Expression a)
el) =
forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe String
-> NonEmpty (Expression a, [Block a])
-> Maybe [Block a]
-> Maybe (Expression a)
-> Block a
BlIf a
a SrcSpan
s Maybe (Expression a)
l Maybe String
mn (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Expression a
e, [Block a]
_bs) -> (Expression a
e, [])) NonEmpty (Expression a, [Block a])
clauses) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const []) Maybe [Block a]
elseBlock) Maybe (Expression a)
el
stripNestedBlocks (BlCase a
a SrcSpan
s Maybe (Expression a)
l Maybe String
mn Expression a
sc [(AList Index a, [Block a])]
clauses Maybe [Block a]
caseDef Maybe (Expression a)
el) =
forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe String
-> Expression a
-> [(AList Index a, [Block a])]
-> Maybe [Block a]
-> Maybe (Expression a)
-> Block a
BlCase a
a SrcSpan
s Maybe (Expression a)
l Maybe String
mn Expression a
sc (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(AList Index a
r, [Block a]
_bs) -> (AList Index a
r, [])) [(AList Index a, [Block a])]
clauses) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const []) Maybe [Block a]
caseDef) Maybe (Expression a)
el
stripNestedBlocks Block a
b = Block a
b
processFunctionCalls :: Data a => Expression (Analysis a) -> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCalls :: forall a.
Data a =>
Expression (Analysis a)
-> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCalls = forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM forall a.
Data a =>
Expression (Analysis a)
-> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCall
processFunctionCall :: Data a => Expression (Analysis a) -> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCall :: forall a.
Data a =>
Expression (Analysis a)
-> BBlocker (Analysis a) (Expression (Analysis a))
processFunctionCall (ExpFunctionCall Analysis a
a SrcSpan
s fn :: Expression (Analysis a)
fn@(ExpValue Analysis a
a' SrcSpan
s' Value (Analysis a)
_) AList Argument (Analysis a)
aargs) = do
let a0 :: Analysis a
a0 = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) a. Functor b => b a -> b (Analysis a)
initAnalysis forall a b. (a -> b) -> a -> b
$ [forall a. Analysis a -> a
prevAnnotation Analysis a
a]
(ASTExprNode
prevN, ASTExprNode
formalN) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
let exps :: [Expression (Analysis a)]
exps = forall a b. (a -> b) -> [a] -> [b]
map forall a. Argument a -> Expression a
argExtractExpr forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Argument (Analysis a)
aargs
let name :: Integer -> String
name Integer
i = forall a. Expression (Analysis a) -> String
varName Expression (Analysis a)
fn forall a. [a] -> [a] -> [a]
++ String
"[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i forall a. [a] -> [a] -> [a]
++ String
"]"
let formal :: Expression (Analysis a) -> Integer -> Expression (Analysis a)
formal (ExpValue Analysis a
_ SrcSpan
s'' (ValVariable String
_)) Integer
i = forall a.
Analysis a -> SrcSpan -> String -> Expression (Analysis a)
genVar Analysis a
a0 SrcSpan
s'' forall a b. (a -> b) -> a -> b
$ Integer -> String
name Integer
i
formal Expression (Analysis a)
e Integer
i = forall a.
Analysis a -> SrcSpan -> String -> Expression (Analysis a)
genVar Analysis a
a0 (forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
e) forall a b. (a -> b) -> a -> b
$ Integer -> String
name Integer
i
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Expression (Analysis a)]
exps [(Integer
1::Integer)..]) forall a b. (a -> b) -> a -> b
$ \ (Expression (Analysis a)
e, Integer
i) ->
forall a. Block a -> BBlocker a ()
addToBBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
(Annotated f, Data (f (Analysis a)), Data a) =>
f (Analysis a) -> f (Analysis a)
analyseAllLhsVars1 forall a b. (a -> b) -> a -> b
$ forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
BlStatement Analysis a
a0 SrcSpan
s forall a. Maybe a
Nothing (forall a.
a -> SrcSpan -> Expression a -> Expression a -> Statement a
StExpressionAssign Analysis a
a' SrcSpan
s' (Expression (Analysis a) -> Integer -> Expression (Analysis a)
formal Expression (Analysis a)
e Integer
i) Expression (Analysis a)
e)
(ASTExprNode
_, ASTExprNode
dummyCallN) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
let retV :: Expression (Analysis a)
retV = forall a.
Analysis a -> SrcSpan -> String -> Expression (Analysis a)
genVar Analysis a
a0 SrcSpan
s forall a b. (a -> b) -> a -> b
$ Integer -> String
name (Integer
0::Integer)
let dummyArgs :: [Argument (Analysis a)]
dummyArgs = forall a b. (a -> b) -> [a] -> [b]
map (\Expression (Analysis a)
e -> forall a.
a -> SrcSpan -> Maybe String -> ArgumentExpression a -> Argument a
Argument Analysis a
a0 SrcSpan
s' forall a. Maybe a
Nothing (forall a. Expression a -> ArgumentExpression a
ArgExpr Expression (Analysis a)
e))
(Expression (Analysis a)
retVforall a. a -> [a] -> [a]
:forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Expression (Analysis a) -> Integer -> Expression (Analysis a)
formal [Expression (Analysis a)]
exps [(Integer
1::Integer)..])
forall a. Block a -> BBlocker a ()
addToBBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
(Annotated f, Data (f (Analysis a)), Data a) =>
f (Analysis a) -> f (Analysis a)
analyseAllLhsVars1 forall a b. (a -> b) -> a -> b
$ forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
BlStatement Analysis a
a SrcSpan
s forall a. Maybe a
Nothing (forall a.
a -> SrcSpan -> Expression a -> AList Argument a -> Statement a
StCall Analysis a
a' SrcSpan
s' Expression (Analysis a)
fn (forall (t :: * -> *) a. Spanned (t a) => a -> [t a] -> AList t a
fromList Analysis a
a0 [Argument (Analysis a)]
dummyArgs))
(ASTExprNode
_, ASTExprNode
returnedN) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Expression (Analysis a)]
exps [(Integer
1::Integer)..]) forall a b. (a -> b) -> a -> b
$ \ (Expression (Analysis a)
e, Integer
i) ->
(forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Expression a -> Bool
isLExpr Expression (Analysis a)
e) forall a b. (a -> b) -> a -> b
$
forall a. Block a -> BBlocker a ()
addToBBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
(Annotated f, Data (f (Analysis a)), Data a) =>
f (Analysis a) -> f (Analysis a)
analyseAllLhsVars1 forall a b. (a -> b) -> a -> b
$ forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
BlStatement Analysis a
a0 SrcSpan
s forall a. Maybe a
Nothing (forall a.
a -> SrcSpan -> Expression a -> Expression a -> Statement a
StExpressionAssign Analysis a
a' SrcSpan
s' Expression (Analysis a)
e (Expression (Analysis a) -> Integer -> Expression (Analysis a)
formal Expression (Analysis a)
e Integer
i)))
String
tempName <- forall a. String -> BBlocker a String
genTemp (forall a. Expression (Analysis a) -> String
varName Expression (Analysis a)
fn)
let temp :: Expression (Analysis a)
temp = forall a.
Analysis a -> SrcSpan -> String -> Expression (Analysis a)
genVar Analysis a
a0 SrcSpan
s String
tempName
forall a. Block a -> BBlocker a ()
addToBBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
(Annotated f, Data (f (Analysis a)), Data a) =>
f (Analysis a) -> f (Analysis a)
analyseAllLhsVars1 forall a b. (a -> b) -> a -> b
$ forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
BlStatement Analysis a
a0 SrcSpan
s forall a. Maybe a
Nothing (forall a.
a -> SrcSpan -> Expression a -> Expression a -> Statement a
StExpressionAssign Analysis a
a0 SrcSpan
s' Expression (Analysis a)
temp Expression (Analysis a)
retV)
(ASTExprNode
_, ASTExprNode
nextN) <- forall a. BBlocker a (ASTExprNode, ASTExprNode)
closeBBlock
forall a (m :: * -> *).
MonadState (BBState a) m =>
[LEdge ()] -> m ()
createEdges [ (ASTExprNode
prevN, ASTExprNode
formalN, ()), (ASTExprNode
formalN, ASTExprNode
dummyCallN, ())
, (ASTExprNode
dummyCallN, ASTExprNode
returnedN, ()), (ASTExprNode
returnedN, ASTExprNode
nextN, ()) ]
forall (m :: * -> *) a. Monad m => a -> m a
return Expression (Analysis a)
temp
processFunctionCall Expression (Analysis a)
e = forall (m :: * -> *) a. Monad m => a -> m a
return Expression (Analysis a)
e
data SuperBBGr a = SuperBBGr { forall a. SuperBBGr a -> BBGr a
superBBGrGraph :: BBGr a
, forall a. SuperBBGr a -> IntMap ProgramUnitName
superBBGrClusters :: IM.IntMap ProgramUnitName
, forall a. SuperBBGr a -> Map ProgramUnitName ASTExprNode
superBBGrEntries :: M.Map PUName SuperNode }
type SuperNode = Node
type SuperEdge = (SuperNode, SuperNode, ELabel)
type PUName = ProgramUnitName
type NLabel a = BB (Analysis a)
type ELabel = ()
genSuperBBGr :: forall a. Data a => BBlockMap (Analysis a) -> SuperBBGr (Analysis a)
genSuperBBGr :: forall a.
Data a =>
BBlockMap (Analysis a) -> SuperBBGr (Analysis a)
genSuperBBGr BBlockMap (Analysis a)
bbm = SuperBBGr { superBBGrGraph :: BBGr (Analysis a)
superBBGrGraph = BBGr (Analysis a)
superGraph''
, superBBGrClusters :: IntMap ProgramUnitName
superBBGrClusters = IntMap ProgramUnitName
cmap
, superBBGrEntries :: Map ProgramUnitName ASTExprNode
superBBGrEntries = Map ProgramUnitName ASTExprNode
entryMap }
where
namedNodes :: [((PUName, Node), NLabel a)]
namedNodes :: [((ProgramUnitName, ASTExprNode), NLabel a)]
namedNodes = [ ((ProgramUnitName
name, ASTExprNode
n), NLabel a
bs) | (ProgramUnitName
name, BBGr (Analysis a)
gr) <- forall k a. Map k a -> [(k, a)]
M.toList BBlockMap (Analysis a)
bbm, (ASTExprNode
n, NLabel a
bs) <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes (forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) ]
namedEdges :: [((PUName, Node), (PUName, Node), ELabel)]
namedEdges :: [((ProgramUnitName, ASTExprNode), (ProgramUnitName, ASTExprNode),
())]
namedEdges = [ ((ProgramUnitName
name, ASTExprNode
n), (ProgramUnitName
name, ASTExprNode
m), ()
l) | (ProgramUnitName
name, BBGr (Analysis a)
gr) <- forall k a. Map k a -> [(k, a)]
M.toList BBlockMap (Analysis a)
bbm, (ASTExprNode
n, ASTExprNode
m, ()
l) <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges (forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) ]
superNodeMap :: M.Map (PUName, Node) SuperNode
superNodeMap :: Map (ProgramUnitName, ASTExprNode) ASTExprNode
superNodeMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [((ProgramUnitName, ASTExprNode), NLabel a)]
namedNodes) [ASTExprNode
1..]
getSuperNode :: (PUName, Node) -> SuperNode
getSuperNode :: (ProgramUnitName, ASTExprNode) -> ASTExprNode
getSuperNode = forall a. String -> Maybe a -> a
fromJustMsg String
"UNDEFINED SUPERNODE" 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 (ProgramUnitName, ASTExprNode) ASTExprNode
superNodeMap
superNodes :: [(SuperNode, NLabel a)]
superNodes :: [(ASTExprNode, NLabel a)]
superNodes = [ ((ProgramUnitName, ASTExprNode) -> ASTExprNode
getSuperNode (ProgramUnitName, ASTExprNode)
n, NLabel a
bs) | ((ProgramUnitName, ASTExprNode)
n, NLabel a
bs) <- [((ProgramUnitName, ASTExprNode), NLabel a)]
namedNodes ]
superEdges :: [(SuperNode, SuperNode, ELabel)]
superEdges :: [LEdge ()]
superEdges = [ ((ProgramUnitName, ASTExprNode) -> ASTExprNode
getSuperNode (ProgramUnitName, ASTExprNode)
n, (ProgramUnitName, ASTExprNode) -> ASTExprNode
getSuperNode (ProgramUnitName, ASTExprNode)
m, ()
l) | ((ProgramUnitName, ASTExprNode)
n, (ProgramUnitName, ASTExprNode)
m, ()
l) <- [((ProgramUnitName, ASTExprNode), (ProgramUnitName, ASTExprNode),
())]
namedEdges ]
superGraph :: Gr (NLabel a) ELabel
superGraph :: Gr (NLabel a) ()
superGraph = forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [(ASTExprNode, NLabel a)]
superNodes [LEdge ()]
superEdges
entryMap :: M.Map PUName SuperNode
entryMap :: Map ProgramUnitName ASTExprNode
entryMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (ProgramUnitName
name, ASTExprNode
n') | ((ProgramUnitName
name, ASTExprNode
n), ASTExprNode
n') <- forall k a. Map k a -> [(k, a)]
M.toList Map (ProgramUnitName, ASTExprNode) ASTExprNode
superNodeMap, ASTExprNode
n forall a. Eq a => a -> a -> Bool
== ASTExprNode
0 ]
exitMap :: M.Map PUName SuperNode
exitMap :: Map ProgramUnitName ASTExprNode
exitMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (ProgramUnitName
name, ASTExprNode
n') | ((ProgramUnitName
name, ASTExprNode
n), ASTExprNode
n') <- forall k a. Map k a -> [(k, a)]
M.toList Map (ProgramUnitName, ASTExprNode) ASTExprNode
superNodeMap, ASTExprNode
n forall a. Eq a => a -> a -> Bool
== -ASTExprNode
1 ]
stCalls :: [(SuperNode, String)]
stCalls :: [(ASTExprNode, String)]
stCalls = [ ((ProgramUnitName, ASTExprNode) -> ASTExprNode
getSuperNode (ProgramUnitName, ASTExprNode)
n, String
sub) | ((ProgramUnitName, ASTExprNode)
n, [BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ (StCall Analysis a
_ SrcSpan
_ Expression (Analysis a)
e AList Argument (Analysis a)
_)]) <- [((ProgramUnitName, ASTExprNode), NLabel a)]
namedNodes
, v :: Expression (Analysis a)
v@ExpValue{} <- [Expression (Analysis a)
e]
, let sub :: String
sub = forall a. Expression (Analysis a) -> String
varName Expression (Analysis a)
v
, String -> ProgramUnitName
Named String
sub forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map ProgramUnitName ASTExprNode
entryMap Bool -> Bool -> Bool
&& String -> ProgramUnitName
Named String
sub forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map ProgramUnitName ASTExprNode
exitMap ]
stCallCtxts :: [([SuperEdge], SuperNode, String, [SuperEdge])]
stCallCtxts :: [([LEdge ()], ASTExprNode, String, [LEdge ()])]
stCallCtxts = [ (forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> ASTExprNode -> [LEdge b]
inn Gr (NLabel a) ()
superGraph ASTExprNode
n, ASTExprNode
n, String
sub, forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> ASTExprNode -> [LEdge b]
out Gr (NLabel a) ()
superGraph ASTExprNode
n) | (ASTExprNode
n, String
sub) <- [(ASTExprNode, String)]
stCalls ]
stCallEdges :: [SuperEdge]
stCallEdges :: [LEdge ()]
stCallEdges = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ (ASTExprNode
m, ASTExprNode
nEn, ()
l) | (ASTExprNode
m, ASTExprNode
_, ()
l) <- [LEdge ()]
inEdges ] forall a. [a] -> [a] -> [a]
++
[ (ASTExprNode
nEx, ASTExprNode
m, ()
l) | (ASTExprNode
_, ASTExprNode
m, ()
l) <- [LEdge ()]
outEdges ]
| ([LEdge ()]
inEdges, ASTExprNode
_, String
sub, [LEdge ()]
outEdges) <- [([LEdge ()], ASTExprNode, String, [LEdge ()])]
stCallCtxts
, let nEn :: ASTExprNode
nEn = forall a. String -> Maybe a -> a
fromJustMsg (String
"UNDEFINED: " forall a. [a] -> [a] -> [a]
++ String
sub) (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> ProgramUnitName
Named String
sub) Map ProgramUnitName ASTExprNode
entryMap)
, let nEx :: ASTExprNode
nEx = forall a. String -> Maybe a -> a
fromJustMsg (String
"UNDEFINED: " forall a. [a] -> [a] -> [a]
++ String
sub) (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> ProgramUnitName
Named String
sub) Map ProgramUnitName ASTExprNode
exitMap) ]
superGraph' :: Gr (NLabel a) ELabel
superGraph' :: Gr (NLabel a) ()
superGraph' = forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
insEdges [LEdge ()]
stCallEdges forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b.
Graph gr =>
[ASTExprNode] -> gr a b -> gr a b
delNodes (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(ASTExprNode, String)]
stCalls) forall a b. (a -> b) -> a -> b
$ Gr (NLabel a) ()
superGraph
cmap :: IM.IntMap PUName
cmap :: IntMap ProgramUnitName
cmap = forall a. [(ASTExprNode, a)] -> IntMap a
IM.fromList [ (ASTExprNode
n, ProgramUnitName
name) | ((ProgramUnitName
name, ASTExprNode
_), ASTExprNode
n) <- forall k a. Map k a -> [(k, a)]
M.toList Map (ProgramUnitName, ASTExprNode) ASTExprNode
superNodeMap ]
mainEntry :: SuperNode
ASTExprNode
mainEntry:[ASTExprNode]
_ = [ ASTExprNode
n | (ASTExprNode
n, NLabel a
_) <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes Gr (NLabel a) ()
superGraph', forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> ASTExprNode -> [ASTExprNode]
pre Gr (NLabel a) ()
superGraph' ASTExprNode
n) ]
superGraph'' :: BBGr (Analysis a)
superGraph'' :: BBGr (Analysis a)
superGraph'' = BBGr { bbgrGr :: Gr (NLabel a) ()
bbgrGr = forall (gr :: * -> * -> *) a b.
Graph gr =>
ASTExprNode -> gr a b -> gr a b
delNode ASTExprNode
mainEntry forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
insEdges [ (ASTExprNode
0, ASTExprNode
m, ()
l) | (ASTExprNode
_, ASTExprNode
m, ()
l) <- forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> ASTExprNode -> [LEdge b]
out Gr (NLabel a) ()
superGraph' ASTExprNode
mainEntry ] forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode (ASTExprNode
0, []) forall a b. (a -> b) -> a -> b
$ Gr (NLabel a) ()
superGraph'
, bbgrEntries :: [ASTExprNode]
bbgrEntries = (ASTExprNode
0forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=ASTExprNode
mainEntry) 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 k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ Map ProgramUnitName ASTExprNode
entryMap
, bbgrExits :: [ASTExprNode]
bbgrExits = (-ASTExprNode
1forall a. a -> [a] -> [a]
:) 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 k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ Map ProgramUnitName ASTExprNode
exitMap }
fromJustMsg :: String -> Maybe a -> a
fromJustMsg :: forall a. String -> Maybe a -> a
fromJustMsg String
_ (Just a
x) = a
x
fromJustMsg String
msg Maybe a
_ = forall a. HasCallStack => String -> a
error String
msg
findLabeledBBlock :: String -> BBGr a -> Maybe Node
findLabeledBBlock :: forall a. String -> BBGr a -> Maybe ASTExprNode
findLabeledBBlock String
llab BBGr a
gr =
forall a. [a] -> Maybe a
listToMaybe [ ASTExprNode
n | (ASTExprNode
n, BB a
bs) <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes (forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr a
gr), Block a
b <- BB a
bs
, ExpValue a
_ SrcSpan
_ (ValInteger String
llab' Maybe (KindParam a)
_) <- forall a. Maybe a -> [a]
maybeToList (forall (f :: * -> *) a. Labeled f => f a -> Maybe (Expression a)
getLabel Block a
b)
, String
llab forall a. Eq a => a -> a -> Bool
== String
llab' ]
showBBGr :: (Out a, Show a) => BBGr a -> String
showBBGr :: forall a. (Out a, Show a) => BBGr a -> String
showBBGr (BBGr Gr (BB a) ()
gr [ASTExprNode]
_ [ASTExprNode]
_) = forall w a. Writer w a -> w
execWriter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes Gr (BB a) ()
gr) forall a b. (a -> b) -> a -> b
$ \ (ASTExprNode
n, BB a
bs) -> do
let b :: String
b = String
"BBLOCK " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ASTExprNode
n forall a. [a] -> [a] -> [a]
++ String
" -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b. (a -> b) -> [a] -> [b]
map (\ (ASTExprNode
_, ASTExprNode
m, ()
_) -> ASTExprNode
m) forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> ASTExprNode -> [LEdge b]
out Gr (BB a) ()
gr ASTExprNode
n)
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ String
"\n\n" forall a. [a] -> [a] -> [a]
++ String
b
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ String
"\n" forall a. [a] -> [a] -> [a]
++ forall a. ASTExprNode -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> ASTExprNode
length String
b) Char
'-' forall a. [a] -> [a] -> [a]
++ String
"\n"
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (((forall a. [a] -> [a] -> [a]
++String
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Out a => a -> String
pretty) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BB a
bs)
showAnalysedBBGr :: (Out a, Show a) => BBGr (Analysis a) -> String
showAnalysedBBGr :: forall a. (Out a, Show a) => BBGr (Analysis a) -> String
showAnalysedBBGr = forall a. (Out a, Show a) => BBGr a -> String
showBBGr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall {a}. [Block (Analysis a)] -> [Block (Maybe ASTExprNode)]
strip)
where
strip :: [Block (Analysis a)] -> [Block (Maybe ASTExprNode)]
strip = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Analysis a -> Maybe ASTExprNode
insLabel)
showSuperBBGr :: (Out a, Show a) => SuperBBGr (Analysis a) -> String
showSuperBBGr :: forall a. (Out a, Show a) => SuperBBGr (Analysis a) -> String
showSuperBBGr = forall a. (Out a, Show a) => BBGr (Analysis a) -> String
showAnalysedBBGr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SuperBBGr a -> BBGr a
superBBGrGraph
showBBlocks :: (Data a, Out a, Show a) => ProgramFile (Analysis a) -> String
showBBlocks :: forall a.
(Data a, Out a, Show a) =>
ProgramFile (Analysis a) -> String
showBBlocks ProgramFile (Analysis a)
pf = ProgramUnit (Analysis a) -> String
perPU forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a.
Data a =>
ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
getPUs ProgramFile (Analysis a)
pf
where
perPU :: ProgramUnit (Analysis a) -> String
perPU PUComment{} = String
""
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 =
String
dashes forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
p forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
dashes forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ forall a. (Out a, Show a) => BBGr a -> String
showBBGr (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 forall {a}. [Block (Analysis a)] -> [Block (Maybe ASTExprNode)]
strip) BBGr (Analysis a)
gr) forall a. [a] -> [a] -> [a]
++ String
"\n\n"
where p :: String
p = String
"| Program Unit " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. ProgramUnit (Analysis a) -> ProgramUnitName
puName ProgramUnit (Analysis a)
pu) forall a. [a] -> [a] -> [a]
++ String
" |"
dashes :: String
dashes = forall a. ASTExprNode -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> ASTExprNode
length String
p) Char
'-'
perPU ProgramUnit (Analysis a)
pu =
String
dashes forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
p forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
dashes forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Out a => a -> String
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Analysis a -> Maybe ASTExprNode
insLabel) (forall a. ProgramUnit a -> [Block a]
programUnitBody ProgramUnit (Analysis a)
pu)) forall a. [a] -> [a] -> [a]
++ String
"\n\n"
where p :: String
p = String
"| Program Unit " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. ProgramUnit (Analysis a) -> ProgramUnitName
puName ProgramUnit (Analysis a)
pu) forall a. [a] -> [a] -> [a]
++ String
" |"
dashes :: String
dashes = forall a. ASTExprNode -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> ASTExprNode
length String
p) Char
'-'
strip :: [Block (Analysis a)] -> [Block (Maybe ASTExprNode)]
strip = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Analysis a -> Maybe ASTExprNode
insLabel)
getPUs :: Data a => ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
getPUs :: forall a.
Data a =>
ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
getPUs = forall from to. Biplate from to => from -> [to]
universeBi
bbgrToDOT :: BBGr a -> String
bbgrToDOT :: forall a. BBGr a -> String
bbgrToDOT = forall a. IntMap ProgramUnitName -> BBGr a -> String
bbgrToDOT' forall a. IntMap a
IM.empty
superBBGrToDOT :: SuperBBGr a -> String
superBBGrToDOT :: forall a. SuperBBGr a -> String
superBBGrToDOT SuperBBGr a
sgr = forall a. IntMap ProgramUnitName -> BBGr a -> String
bbgrToDOT' (forall a. SuperBBGr a -> IntMap ProgramUnitName
superBBGrClusters SuperBBGr a
sgr) (forall a. SuperBBGr a -> BBGr a
superBBGrGraph SuperBBGr a
sgr)
bbgrToDOT' :: IM.IntMap ProgramUnitName -> BBGr a -> String
bbgrToDOT' :: forall a. IntMap ProgramUnitName -> BBGr a -> String
bbgrToDOT' IntMap ProgramUnitName
clusters' (BBGr{ bbgrGr :: forall a. BBGr a -> Gr (BB a) ()
bbgrGr = Gr (BB a) ()
gr }) = forall w a. Writer w a -> w
execWriter forall a b. (a -> b) -> a -> b
$ do
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell String
"strict digraph {\n"
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell String
"node [shape=box,fontname=\"Courier New\"]\n"
let entryNodes :: [ASTExprNode]
entryNodes = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> ASTExprNode -> [ASTExprNode]
pre Gr (BB a) ()
gr) (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [ASTExprNode]
nodes Gr (BB a) ()
gr)
let nodes' :: [ASTExprNode]
nodes' = forall (gr :: * -> * -> *) a b.
Graph gr =>
[ASTExprNode] -> gr a b -> [ASTExprNode]
bfsn [ASTExprNode]
entryNodes Gr (BB a) ()
gr
[()]
_ <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ASTExprNode]
nodes' forall a b. (a -> b) -> a -> b
$ \ ASTExprNode
n -> do
let Just BB a
bs = forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> ASTExprNode -> Maybe a
lab Gr (BB a) ()
gr ASTExprNode
n
let mname :: Maybe ProgramUnitName
mname = forall a. ASTExprNode -> IntMap a -> Maybe a
IM.lookup ASTExprNode
n IntMap ProgramUnitName
clusters'
case Maybe ProgramUnitName
mname of Just ProgramUnitName
name -> do forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ String
"subgraph \"cluster " forall a. [a] -> [a] -> [a]
++ ProgramUnitName -> String
showPUName ProgramUnitName
name forall a. [a] -> [a] -> [a]
++ String
"\" {\n"
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ String
"label=\"" forall a. [a] -> [a] -> [a]
++ ProgramUnitName -> String
showPUName ProgramUnitName
name forall a. [a] -> [a] -> [a]
++ String
"\"\n"
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell String
"fontname=\"Courier New\"\nfontsize=24\n"
Maybe ProgramUnitName
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ String
"bb" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ASTExprNode
n forall a. [a] -> [a] -> [a]
++ String
"[label=\"" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ASTExprNode
n forall a. [a] -> [a] -> [a]
++ String
"\\l" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Block a -> String
showBlock BB a
bs forall a. [a] -> [a] -> [a]
++ String
"\"]\n"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null BB a
bs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ String
"bb" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ASTExprNode
n forall a. [a] -> [a] -> [a]
++ String
"[shape=circle]\n"
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ String
"bb" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ASTExprNode
n forall a. [a] -> [a] -> [a]
++ String
" -> {"
[()]
_ <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> ASTExprNode -> [ASTExprNode]
suc Gr (BB a) ()
gr ASTExprNode
n) forall a b. (a -> b) -> a -> b
$ \ ASTExprNode
m -> forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (String
" bb" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ASTExprNode
m)
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell String
"}\n"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe ProgramUnitName
mname) forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell String
"}\n"
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell String
"}\n"
showPUName :: ProgramUnitName -> String
showPUName :: ProgramUnitName -> String
showPUName (Named String
n) = String
n
showPUName ProgramUnitName
NamelessBlockData = String
".blockdata."
showPUName ProgramUnitName
NamelessMain = String
".main."
showPUName ProgramUnitName
NamelessComment = String
".comment."
showBlock :: Block a -> String
showBlock :: forall a. Block a -> String
showBlock (BlStatement a
_ SrcSpan
_ Maybe (Expression a)
mlab Statement a
st)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String
str :: String) = String
""
| Bool
otherwise = forall a. Maybe (Expression a) -> String
showLab Maybe (Expression a)
mlab forall a. [a] -> [a] -> [a]
++ String
str forall a. [a] -> [a] -> [a]
++ String
"\\l"
where
str :: String
str =
case Statement a
st of
StExpressionAssign a
_ SrcSpan
_ Expression a
e1 Expression a
e2 -> forall a. Expression a -> String
showExpr Expression a
e1 forall a. [a] -> [a] -> [a]
++ String
" <- " forall a. [a] -> [a] -> [a]
++ forall a. Expression a -> String
showExpr Expression a
e2
StIfLogical a
_ SrcSpan
_ Expression a
e1 Statement a
_ -> String
"if " forall a. [a] -> [a] -> [a]
++ forall a. Expression a -> String
showExpr Expression a
e1
StWrite a
_ SrcSpan
_ AList ControlPair a
_ (Just AList Expression a
aexps) -> String
"write " forall a. [a] -> [a] -> [a]
++ forall a1 (t :: * -> *) a2.
[a1] -> (t a2 -> [a1]) -> AList t a2 -> [a1]
aIntercalate String
", " forall a. Expression a -> String
showExpr AList Expression a
aexps
StPrint a
_ SrcSpan
_ Expression a
_ (Just AList Expression a
aexps) -> String
"print " forall a. [a] -> [a] -> [a]
++ forall a1 (t :: * -> *) a2.
[a1] -> (t a2 -> [a1]) -> AList t a2 -> [a1]
aIntercalate String
", " forall a. Expression a -> String
showExpr AList Expression a
aexps
StCall a
_ SrcSpan
_ Expression a
cn AList Argument a
_ -> String
"call " forall a. [a] -> [a] -> [a]
++ forall a. Expression a -> String
showExpr Expression a
cn
StDeclaration a
_ SrcSpan
_ TypeSpec a
ty Maybe (AList Attribute a)
Nothing AList Declarator a
adecls ->
forall a. TypeSpec a -> String
showType TypeSpec a
ty forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a1 (t :: * -> *) a2.
[a1] -> (t a2 -> [a1]) -> AList t a2 -> [a1]
aIntercalate String
", " forall a. Declarator a -> String
showDecl AList Declarator a
adecls
StDeclaration a
_ SrcSpan
_ TypeSpec a
ty (Just AList Attribute a
aattrs) AList Declarator a
adecls ->
forall a. TypeSpec a -> String
showType TypeSpec a
ty forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++
forall a1 (t :: * -> *) a2.
[a1] -> (t a2 -> [a1]) -> AList t a2 -> [a1]
aIntercalate String
", " forall a. Attribute a -> String
showAttr AList Attribute a
aattrs forall a. [a] -> [a] -> [a]
++
forall a1 (t :: * -> *) a2.
[a1] -> (t a2 -> [a1]) -> AList t a2 -> [a1]
aIntercalate String
", " forall a. Declarator a -> String
showDecl AList Declarator a
adecls
StDimension a
_ SrcSpan
_ AList Declarator a
adecls -> String
"dimension " forall a. [a] -> [a] -> [a]
++ forall a1 (t :: * -> *) a2.
[a1] -> (t a2 -> [a1]) -> AList t a2 -> [a1]
aIntercalate String
", " forall a. Declarator a -> String
showDecl AList Declarator a
adecls
StExit{} -> String
"exit"
Statement a
_ -> String
"<unhandled statement: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Data a => a -> Constr
toConstr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) Statement a
st)) forall a. [a] -> [a] -> [a]
++ String
">"
showBlock (BlIf a
_ SrcSpan
_ Maybe (Expression a)
mlab Maybe String
_ ((Expression a
e1, [Block a]
_) :| [(Expression a, [Block a])]
_) Maybe [Block a]
_ Maybe (Expression a)
_) =
forall a. Maybe (Expression a) -> String
showLab Maybe (Expression a)
mlab forall a. [a] -> [a] -> [a]
++ String
"if " forall a. [a] -> [a] -> [a]
++ forall a. Expression a -> String
showExpr Expression a
e1 forall a. [a] -> [a] -> [a]
++ String
"\\l"
showBlock (BlDo a
_ SrcSpan
_ Maybe (Expression a)
mlab Maybe String
_ Maybe (Expression a)
_ (Just DoSpecification a
spec) [Block a]
_ Maybe (Expression a)
_) =
forall a. Maybe (Expression a) -> String
showLab Maybe (Expression a)
mlab forall a. [a] -> [a] -> [a]
++ String
"do " forall a. [a] -> [a] -> [a]
++ forall a. Expression a -> String
showExpr Expression a
e1 forall a. [a] -> [a] -> [a]
++ String
" <- " forall a. [a] -> [a] -> [a]
++
forall a. Expression a -> String
showExpr Expression a
e2 forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++
forall a. Expression a -> String
showExpr Expression a
e3 forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"1" forall a. Expression a -> String
showExpr Maybe (Expression a)
me4 forall a. [a] -> [a] -> [a]
++ String
"\\l"
where DoSpecification a
_ SrcSpan
_ (StExpressionAssign a
_ SrcSpan
_ Expression a
e1 Expression a
e2) Expression a
e3 Maybe (Expression a)
me4 = DoSpecification a
spec
showBlock (BlDo a
_ SrcSpan
_ Maybe (Expression a)
_ Maybe String
_ Maybe (Expression a)
_ Maybe (DoSpecification a)
Nothing [Block a]
_ Maybe (Expression a)
_) = String
"do"
showBlock (BlComment{}) = String
""
showBlock Block a
b = String
"<unhandled block: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Data a => a -> Constr
toConstr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) Block a
b)) forall a. [a] -> [a] -> [a]
++ String
">"
showAttr :: Attribute a -> String
showAttr :: forall a. Attribute a -> String
showAttr (AttrParameter a
_ SrcSpan
_) = String
"parameter"
showAttr (AttrPublic a
_ SrcSpan
_) = String
"public"
showAttr (AttrPrivate a
_ SrcSpan
_) = String
"private"
showAttr (AttrProtected a
_ SrcSpan
_) = String
"protected"
showAttr (AttrAllocatable a
_ SrcSpan
_) = String
"allocatable"
showAttr (AttrAsynchronous a
_ SrcSpan
_) = String
"asynchronous"
showAttr (AttrDimension a
_ SrcSpan
_ AList DimensionDeclarator a
aDimDecs) =
String
"dimension ( " forall a. [a] -> [a] -> [a]
++ forall a1 (t :: * -> *) a2.
[a1] -> (t a2 -> [a1]) -> AList t a2 -> [a1]
aIntercalate String
", " forall a. DimensionDeclarator a -> String
showDim AList DimensionDeclarator a
aDimDecs forall a. [a] -> [a] -> [a]
++ String
" )"
showAttr (AttrExternal a
_ SrcSpan
_) = String
"external"
showAttr (AttrIntent a
_ SrcSpan
_ Intent
In) = String
"intent (in)"
showAttr (AttrIntent a
_ SrcSpan
_ Intent
Out) = String
"intent (out)"
showAttr (AttrIntent a
_ SrcSpan
_ Intent
InOut) = String
"intent (inout)"
showAttr (AttrIntrinsic a
_ SrcSpan
_) = String
"intrinsic"
showAttr (AttrOptional a
_ SrcSpan
_) = String
"optional"
showAttr (AttrPointer a
_ SrcSpan
_) = String
"pointer"
showAttr (AttrSave a
_ SrcSpan
_) = String
"save"
showAttr (AttrTarget a
_ SrcSpan
_) = String
"target"
showAttr (AttrValue a
_ SrcSpan
_) = String
"value"
showAttr (AttrVolatile a
_ SrcSpan
_) = String
"volatile"
showAttr (AttrSuffix a
_ SrcSpan
_ (SfxBind a
_ SrcSpan
_ Maybe (Expression a)
Nothing)) = String
"bind(c)"
showAttr (AttrSuffix a
_ SrcSpan
_ (SfxBind a
_ SrcSpan
_ (Just Expression a
e))) = String
"bind(c,name=" forall a. [a] -> [a] -> [a]
++ forall a. Expression a -> String
showExpr Expression a
e forall a. [a] -> [a] -> [a]
++ String
")"
showLab :: Maybe (Expression a) -> String
showLab :: forall a. Maybe (Expression a) -> String
showLab Maybe (Expression a)
a =
case Maybe (Expression a)
a of
Maybe (Expression a)
Nothing -> forall a. ASTExprNode -> a -> [a]
replicate ASTExprNode
6 Char
' '
Just (ExpValue a
_ SrcSpan
_ (ValInteger String
l Maybe (KindParam a)
_)) -> Char
' 'forall a. a -> [a] -> [a]
:String
l forall a. [a] -> [a] -> [a]
++ forall a. ASTExprNode -> a -> [a]
replicate (ASTExprNode
5 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> ASTExprNode
length String
l) Char
' '
Maybe (Expression a)
_ -> forall a. HasCallStack => String -> a
error String
"unhandled showLab"
showValue :: Value a -> String
showValue :: forall a. Value a -> String
showValue (ValVariable String
v) = String
v
showValue (ValIntrinsic String
v) = String
v
showValue (ValInteger String
v Maybe (KindParam a)
_) = String
v
showValue (ValReal RealLit
v Maybe (KindParam a)
_) = RealLit -> String
prettyHsRealLit RealLit
v
showValue v :: Value a
v@ValComplex{} = Doc -> String
render forall a b. (a -> b) -> a -> b
$ forall t. Pretty t => FortranVersion -> t -> Doc
pprint' forall a. HasCallStack => a
undefined Value a
v
showValue (ValString String
s) = String
"\\\"" forall a. [a] -> [a] -> [a]
++ String -> String
escapeStr String
s forall a. [a] -> [a] -> [a]
++ String
"\\\""
showValue Value a
v = String
"<unhandled value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Data a => a -> Constr
toConstr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) Value a
v)) forall a. [a] -> [a] -> [a]
++ String
">"
escapeStr :: String -> String
escapeStr :: String -> String
escapeStr = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr [(Char, Bool)] -> Maybe ((Char, Bool), [(Char, Bool)])
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (,Bool
False)
where
f :: [(Char, Bool)] -> Maybe ((Char, Bool), [(Char, Bool)])
f [] = forall a. Maybe a
Nothing
f ((Char
c,Bool
False):[(Char, Bool)]
cs)
| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\"\\" = forall a. a -> Maybe a
Just ((Char
'\\', Bool
False), (Char
c, Bool
True)forall a. a -> [a] -> [a]
:[(Char, Bool)]
cs)
f ((Char
c,Bool
_):[(Char, Bool)]
cs) = forall a. a -> Maybe a
Just ((Char
c, Bool
False), [(Char, Bool)]
cs)
showExpr :: Expression a -> String
showExpr :: forall a. Expression a -> String
showExpr (ExpValue a
_ SrcSpan
_ Value a
v) = forall a. Value a -> String
showValue Value a
v
showExpr (ExpBinary a
_ SrcSpan
_ BinaryOp
op Expression a
e1 Expression a
e2) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Expression a -> String
showExpr Expression a
e1 forall a. [a] -> [a] -> [a]
++ BinaryOp -> String
showOp BinaryOp
op forall a. [a] -> [a] -> [a]
++ forall a. Expression a -> String
showExpr Expression a
e2 forall a. [a] -> [a] -> [a]
++ String
")"
showExpr (ExpUnary a
_ SrcSpan
_ UnaryOp
op Expression a
e) = String
"(" forall a. [a] -> [a] -> [a]
++ UnaryOp -> String
showUOp UnaryOp
op forall a. [a] -> [a] -> [a]
++ forall a. Expression a -> String
showExpr Expression a
e forall a. [a] -> [a] -> [a]
++ String
")"
showExpr (ExpSubscript a
_ SrcSpan
_ Expression a
e1 AList Index a
aexps) = forall a. Expression a -> String
showExpr Expression a
e1 forall a. [a] -> [a] -> [a]
++ String
"[" forall a. [a] -> [a] -> [a]
++
forall a1 (t :: * -> *) a2.
[a1] -> (t a2 -> [a1]) -> AList t a2 -> [a1]
aIntercalate String
", " forall a. Index a -> String
showIndex AList Index a
aexps forall a. [a] -> [a] -> [a]
++ String
"]"
showExpr Expression a
e = String
"<unhandled expr: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Data a => a -> Constr
toConstr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) Expression a
e)) forall a. [a] -> [a] -> [a]
++ String
">"
showIndex :: Index a -> String
showIndex :: forall a. Index a -> String
showIndex (IxSingle a
_ SrcSpan
_ Maybe String
_ Expression a
i) = forall a. Expression a -> String
showExpr Expression a
i
showIndex (IxRange a
_ SrcSpan
_ Maybe (Expression a)
l Maybe (Expression a)
u Maybe (Expression a)
s) =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. Expression a -> String
showExpr Maybe (Expression a)
l forall a. [a] -> [a] -> [a]
++
Char
':' forall a. a -> [a] -> [a]
: forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. Expression a -> String
showExpr Maybe (Expression a)
u forall a. [a] -> [a] -> [a]
++
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Expression a
u' -> Char
':' forall a. a -> [a] -> [a]
: forall a. Expression a -> String
showExpr Expression a
u') Maybe (Expression a)
s
showUOp :: UnaryOp -> String
showUOp :: UnaryOp -> String
showUOp UnaryOp
Plus = String
"+"
showUOp UnaryOp
Minus = String
"-"
showUOp UnaryOp
Not = String
"!"
showUOp (UnCustom String
x) = forall a. Show a => a -> String
show String
x
showOp :: BinaryOp -> String
showOp :: BinaryOp -> String
showOp BinaryOp
Addition = String
" + "
showOp BinaryOp
Multiplication = String
" * "
showOp BinaryOp
Subtraction = String
" - "
showOp BinaryOp
Division = String
" / "
showOp BinaryOp
Concatenation = String
" // "
showOp BinaryOp
op = String
" ." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BinaryOp
op forall a. [a] -> [a] -> [a]
++ String
". "
showType :: TypeSpec a -> String
showType :: forall a. TypeSpec a -> String
showType (TypeSpec a
_ SrcSpan
_ BaseType
t (Just Selector a
_)) = BaseType -> String
showBaseType BaseType
t forall a. [a] -> [a] -> [a]
++ String
"(selector)"
showType (TypeSpec a
_ SrcSpan
_ BaseType
t Maybe (Selector a)
Nothing) = BaseType -> String
showBaseType BaseType
t
showBaseType :: BaseType -> String
showBaseType :: BaseType -> String
showBaseType BaseType
TypeInteger = String
"integer"
showBaseType BaseType
TypeReal = String
"real"
showBaseType BaseType
TypeDoublePrecision = String
"double"
showBaseType BaseType
TypeComplex = String
"complex"
showBaseType BaseType
TypeDoubleComplex = String
"doublecomplex"
showBaseType BaseType
TypeLogical = String
"logical"
showBaseType BaseType
TypeCharacter = String
"character"
showBaseType (TypeCustom String
s) = String
"type(" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
")"
showBaseType BaseType
TypeByte = String
"byte"
showBaseType BaseType
ClassStar = String
"class(*)"
showBaseType (ClassCustom String
s) = String
"class(" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
")"
showDecl :: Declarator a -> String
showDecl :: forall a. Declarator a -> String
showDecl (Declarator a
_ SrcSpan
_ Expression a
e DeclaratorType a
mAdims Maybe (Expression a)
length' Maybe (Expression a)
initial) =
let partDims :: String
partDims = case DeclaratorType a
mAdims of
DeclaratorType a
ScalarDecl -> forall a. Monoid a => a
mempty
ArrayDecl AList DimensionDeclarator a
dims ->
String
"(" forall a. [a] -> [a] -> [a]
++ forall a1 (t :: * -> *) a2.
[a1] -> (t a2 -> [a1]) -> AList t a2 -> [a1]
aIntercalate String
"," forall a. DimensionDeclarator a -> String
showDim AList DimensionDeclarator a
dims forall a. [a] -> [a] -> [a]
++ String
")"
in forall a. Expression a -> String
showExpr Expression a
e
forall a. [a] -> [a] -> [a]
++ String
partDims
forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Expression a
e' -> String
"*" forall a. [a] -> [a] -> [a]
++ forall a. Expression a -> String
showExpr Expression a
e') Maybe (Expression a)
length'
forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Expression a
e' -> String
" = " forall a. [a] -> [a] -> [a]
++ forall a. Expression a -> String
showExpr Expression a
e') Maybe (Expression a)
initial
showDim :: DimensionDeclarator a -> String
showDim :: forall a. DimensionDeclarator a -> String
showDim (DimensionDeclarator a
_ SrcSpan
_ Maybe (Expression a)
me1 Maybe (Expression a)
me2) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((forall a. [a] -> [a] -> [a]
++String
":") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Expression a -> String
showExpr) Maybe (Expression a)
me1 forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. Expression a -> String
showExpr Maybe (Expression a)
me2
aIntercalate :: [a1] -> (t a2 -> [a1]) -> AList t a2 -> [a1]
aIntercalate :: forall a1 (t :: * -> *) a2.
[a1] -> (t a2 -> [a1]) -> AList t a2 -> [a1]
aIntercalate [a1]
sep t a2 -> [a1]
f = forall a. [a] -> [[a]] -> [a]
intercalate [a1]
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map t a2 -> [a1]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. AList t a -> [t a]
aStrip
noSrcSpan :: SrcSpan
noSrcSpan :: SrcSpan
noSrcSpan = Position -> Position -> SrcSpan
SrcSpan Position
initPosition Position
initPosition
ufoldM' :: (Graph gr, Monad m) => (Context a b -> c -> m c) -> c -> gr a b -> m c
ufoldM' :: forall (gr :: * -> * -> *) (m :: * -> *) a b c.
(Graph gr, Monad m) =>
(Context a b -> c -> m c) -> c -> gr a b -> m c
ufoldM' Context a b -> c -> m c
f c
u gr a b
g
| forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = forall (m :: * -> *) a. Monad m => a -> m a
return c
u
| Bool
otherwise = Context a b -> c -> m c
f Context a b
c forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (gr :: * -> * -> *) (m :: * -> *) a b c.
(Graph gr, Monad m) =>
(Context a b -> c -> m c) -> c -> gr a b -> m c
ufoldM' Context a b -> c -> m c
f c
u gr a b
g'
where
(Context a b
c,gr a b
g') = forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> GDecomp gr a b
matchAny gr a b
g
gmapM' :: (DynGraph gr, Monad m) => (Context a b -> m (Context c d)) -> gr a b -> m (gr c d)
gmapM' :: forall (gr :: * -> * -> *) (m :: * -> *) a b c d.
(DynGraph gr, Monad m) =>
(Context a b -> m (Context c d)) -> gr a b -> m (gr c d)
gmapM' Context a b -> m (Context c d)
f = forall (gr :: * -> * -> *) (m :: * -> *) a b c.
(Graph gr, Monad m) =>
(Context a b -> c -> m c) -> c -> gr a b -> m c
ufoldM' (\ Context a b
c gr c d
g -> Context a b -> m (Context c d)
f Context a b
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Context c d
c' -> forall (m :: * -> *) a. Monad m => a -> m a
return (Context c d
c' forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
& gr c d
g)) forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty
nmapM' :: (DynGraph gr, Monad m) => (a -> m c) -> gr a b -> m (gr c b)
nmapM' :: forall (gr :: * -> * -> *) (m :: * -> *) a c b.
(DynGraph gr, Monad m) =>
(a -> m c) -> gr a b -> m (gr c b)
nmapM' a -> m c
f = forall (gr :: * -> * -> *) (m :: * -> *) a b c d.
(DynGraph gr, Monad m) =>
(Context a b -> m (Context c d)) -> gr a b -> m (gr c d)
gmapM' (\ (Adj b
p,ASTExprNode
v,a
l,Adj b
s) -> a -> m c
f a
l forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ c
l' -> forall (m :: * -> *) a. Monad m => a -> m a
return (Adj b
p,ASTExprNode
v,c
l',Adj b
s))