fortran-src-0.15.1: Parsers and analyses for Fortran standards 66, 77, 90, 95 and 2003 (partial).
Safe HaskellSafe-Inferred
LanguageHaskell2010

Language.Fortran.Analysis.DataFlow

Description

Dataflow analysis to be applied once basic block analysis is complete.

Synopsis

Documentation

dominators :: BBGr a -> DomMap Source #

Compute dominators of each bblock in the graph. Node A dominates node B when all paths from the start node of that program unit must pass through node A in order to reach node B. That will be represented as the relation (B, [A, ...]) in the DomMap.

iDominators :: BBGr a -> IDomMap Source #

Compute the immediate dominator of each bblock in the graph. The immediate dominator is, in a sense, the closest dominator of a node. Given nodes A and B, you can say that node A is immediately dominated by node B if there does not exist any node C such that: node A dominates node C and node C dominates node B.

type DomMap = BBNodeMap BBNodeSet Source #

DomMap : node -> dominators of node

type IDomMap = BBNodeMap BBNode Source #

IDomMap : node -> immediate dominator of node

postOrder :: OrderF a Source #

The postordering of a graph outputs the label after traversal of children.

revPostOrder :: OrderF a Source #

Reversed postordering.

preOrder :: OrderF a Source #

The preordering of a graph outputs the label before traversal of children.

revPreOrder :: OrderF a Source #

Reversed preordering.

type OrderF a = BBGr a -> [Node] Source #

An OrderF is a function from graph to a specific ordering of nodes.

dataFlowSolver Source #

Arguments

:: (NFData t, Ord t) 
=> BBGr a

basic block graph

-> (Node -> InOut t)

initialisation for in and out dataflows

-> OrderF a

ordering function

-> (OutF t -> InF t)

compute the in-flow given an out-flow function

-> (InF t -> OutF t)

compute the out-flow given an in-flow function

-> InOutMap t

final dataflow for each node

Apply the iterative dataflow analysis method. Forces evaluation of intermediate data structures at each step.

type InOut t = (t, t) Source #

InOut : (dataflow into the bblock, dataflow out of the bblock)

type InOutMap t = BBNodeMap (InOut t) Source #

InOutMap : node -> (dataflow into node, dataflow out of node)

type InF t = Node -> t Source #

InF, a function that returns the in-dataflow for a given node

type OutF t = Node -> t Source #

OutF, a function that returns the out-dataflow for a given node

liveVariableAnalysis :: Data a => BBGr (Analysis a) -> InOutMap (Set Name) Source #

Dataflow analysis for live variables given basic block graph. Muchnick, p. 445: A variable is "live" at a particular program point if there is a path to the exit along which its value may be used before it is redefined. It is "dead" if there is no such path.

reachingDefinitions :: Data a => DefMap -> BBGr (Analysis a) -> InOutMap ASTBlockNodeSet Source #

Reaching definitions dataflow analysis. Reaching definitions are the set of variable-defining AST-block labels that may reach a program point. Suppose AST-block with label A defines a variable named v. Label A may reach another program point labeled P if there is at least one program path from label A to label P that does not redefine variable v.

genUDMap :: Data a => BlockMap a -> DefMap -> BBGr (Analysis a) -> InOutMap ASTBlockNodeSet -> UDMap Source #

use-def map: map AST-block labels of variable-using AST-blocks to the AST-blocks that define those variables.

genDUMap :: Data a => BlockMap a -> DefMap -> BBGr (Analysis a) -> InOutMap ASTBlockNodeSet -> DUMap Source #

def-use map: map AST-block labels of defining AST-blocks to the AST-blocks that may use the definition.

duMapToUdMap :: DUMap -> UDMap Source #

Invert the DUMap into a UDMap

type UDMap = ASTBlockNodeMap ASTBlockNodeSet Source #

UDMap : use -> { definition }

type DUMap = ASTBlockNodeMap ASTBlockNodeSet Source #

DUMap : definition -> { use }

genFlowsToGraph Source #

Arguments

:: Data a 
=> BlockMap a 
-> DefMap 
-> BBGr (Analysis a) 
-> InOutMap ASTBlockNodeSet

result of reaching definitions

-> FlowsGraph a 

"Flows-To" analysis. Represent def-use map as a graph.

type FlowsGraph a = Gr (Block (Analysis a)) () Source #

FlowsGraph : nodes as AST-block (numbered by label), edges showing which definitions contribute to which uses.

genVarFlowsToMap :: Data a => DefMap -> FlowsGraph a -> VarFlowsMap Source #

Create a map (A -> Bs) where A "flows" or contributes towards the variables Bs.

type VarFlowsMap = Map Name (Set Name) Source #

Represent "flows" between variables

type ParameterVarMap = Map Name FValue Source #

The map of all parameter variables and their corresponding values

type ConstExpMap = ASTExprNodeMap (Maybe FValue) Source #

The map of all expressions and whether they are undecided (not present in map), a constant value (Just), or probably not constant (Nothing).

genConstExpMap :: forall a. Data a => ProgramFile (Analysis a) -> ConstExpMap Source #

Generate a constant-expression map with information about the expressions (identified by insLabel numbering) in the ProgramFile pf (must have analysis initiated & basic blocks generated) .

analyseConstExps :: forall a. Data a => ProgramFile (Analysis a) -> ProgramFile (Analysis a) Source #

Get constant-expression information and put it into the AST analysis annotation. Must occur after analyseBBlocks.

analyseParameterVars :: forall a. Data a => ParameterVarMap -> ProgramFile (Analysis a) -> ProgramFile (Analysis a) Source #

Annotate AST with constant-expression information based on given ParameterVarMap.

genBlockMap :: Data a => ProgramFile (Analysis a) -> BlockMap a Source #

Build a BlockMap from the AST. This can only be performed after analyseBasicBlocks has operated, created basic blocks, and labeled all of the AST-blocks with unique numbers.

genDefMap :: Data a => BlockMap a -> DefMap Source #

Build a DefMap from the BlockMap. This allows us to quickly look up the AST-block labels that wrote into the given variable.

type BlockMap a = ASTBlockNodeMap (Block (Analysis a)) Source #

BlockMap : AST-block label -> AST-block Each AST-block has been given a unique number label during analysis of basic blocks. The purpose of this map is to provide the ability to lookup AST-blocks by label.

type DefMap = Map Name ASTBlockNodeSet Source #

DefMap : variable name -> { AST-block label }

genCallMap :: Data a => ProgramFile (Analysis a) -> CallMap Source #

Create a call map showing the structure of the program.

type CallMap = Map ProgramUnitName (Set Name) Source #

CallMap : program unit name -> { name of function or subroutine }

loopNodes :: Graph gr => BackEdgeMap -> gr a b -> [BBNodeSet] Source #

For each loop in the program, find out which bblock nodes are part of the loop by looking through the backedges (m, n) where n is considered the 'loop-header', delete n from the map, and then do a reverse-depth-first traversal starting from m to find all the nodes of interest. Intersect this with the strongly-connected component containing m, in case of improper graphs with weird control transfers.

genBackEdgeMap :: Graph gr => DomMap -> gr a b -> BackEdgeMap Source #

Find the edges that 'loop back' in the graph; ones where the target node dominates the source node. If the backedges are viewed as (m -> n) then n is considered the 'loop-header'

sccWith :: Graph gr => Node -> gr a b -> [Node] Source #

The strongly connected component containing a given node.

type BackEdgeMap = BBNodeMap BBNode Source #

BackEdgeMap : bblock node -> bblock node

genLoopNodeMap :: Graph gr => BackEdgeMap -> gr a b -> LoopNodeMap Source #

Similar to loopNodes except it creates a map from loop-header to the set of loop nodes, for each loop-header.

type LoopNodeMap = BBNodeMap BBNodeSet Source #

LoopNodeMap : bblock node -> { bblock node }

genInductionVarMap :: Data a => BackEdgeMap -> BBGr (Analysis a) -> InductionVarMap Source #

For each loop in the program, figure out the names of the induction variables: the variables that are used to represent the current iteration of the loop.

type InductionVarMap = BBNodeMap (Set Name) Source #

Map of loop header nodes to the induction variables within that loop.

genInductionVarMapByASTBlock :: forall a. Data a => BackEdgeMap -> BBGr (Analysis a) -> InductionVarMapByASTBlock Source #

Generate an induction variable map that is indexed by the labels on AST-blocks within those loops.

type InductionVarMapByASTBlock = ASTBlockNodeMap (Set Name) Source #

InductionVarMapByASTBlock : AST-block label -> { name }

genDerivedInductionMap :: forall a. Data a => BackEdgeMap -> BBGr (Analysis a) -> DerivedInductionMap Source #

For every expression in a loop, try to derive its relationship to a basic induction variable.

data InductionExpr Source #

Constructors

IETop 
IELinear !Name !Int !Int 
IEBottom 

Instances

Instances details
Data InductionExpr Source # 
Instance details

Defined in Language.Fortran.Analysis.DataFlow

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> InductionExpr -> c InductionExpr #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c InductionExpr #

toConstr :: InductionExpr -> Constr #

dataTypeOf :: InductionExpr -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c InductionExpr) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InductionExpr) #

gmapT :: (forall b. Data b => b -> b) -> InductionExpr -> InductionExpr #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> InductionExpr -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> InductionExpr -> r #

gmapQ :: (forall d. Data d => d -> u) -> InductionExpr -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> InductionExpr -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> InductionExpr -> m InductionExpr #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> InductionExpr -> m InductionExpr #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> InductionExpr -> m InductionExpr #

Generic InductionExpr Source # 
Instance details

Defined in Language.Fortran.Analysis.DataFlow

Associated Types

type Rep InductionExpr :: Type -> Type #

Show InductionExpr Source # 
Instance details

Defined in Language.Fortran.Analysis.DataFlow

NFData InductionExpr Source # 
Instance details

Defined in Language.Fortran.Analysis.DataFlow

Methods

rnf :: InductionExpr -> () #

Eq InductionExpr Source # 
Instance details

Defined in Language.Fortran.Analysis.DataFlow

Ord InductionExpr Source # 
Instance details

Defined in Language.Fortran.Analysis.DataFlow

type Rep InductionExpr Source # 
Instance details

Defined in Language.Fortran.Analysis.DataFlow

type Rep InductionExpr = D1 ('MetaData "InductionExpr" "Language.Fortran.Analysis.DataFlow" "fortran-src-0.15.1-inplace" 'False) (C1 ('MetaCons "IETop" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "IELinear" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int))) :+: C1 ('MetaCons "IEBottom" 'PrefixI 'False) (U1 :: Type -> Type)))

showDataFlow :: (Data a, Out a, Show a) => ProgramFile (Analysis a) -> String Source #

Show some information about dataflow analyses.

showFlowsDOT :: (Data a, Out a, Show a) => ProgramFile (Analysis a) -> BBGr (Analysis a) -> ASTBlockNode -> Bool -> String Source #

Outputs a DOT-formatted graph showing flow-to data starting at the given AST-Block node in the given Basic Block graph.