{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Language.Fortran.Vars.ConstantPropagation
( constantPropagationValue
, ValueOf
)
where
import Language.Fortran.Vars ( programFileModel )
import Language.Fortran.Vars.Types
import Language.Fortran.Vars.Kind
( getTypeKind )
import Language.Fortran.Vars.Range
( Range
, overlap
, anyOverlap
)
import Language.Fortran.Vars.Eval.Deprecated.Operation
( valueToExpVal )
import Language.Fortran.Vars.MemoryLocation
( generateLinearizedIndexRange )
import Language.Fortran.Vars.CPValue
( CPValue(..)
, meet
, unaryOper
, binaryOper
, isTop
, isBot
, isConstInt
)
import Language.Fortran.AST
import Language.Fortran.Analysis ( BBGr(..)
, Analysis(..)
, srcName
)
import Language.Fortran.Util.Position ( SrcSpan
, getSpan
)
import Language.Fortran.Analysis.BBlocks
( BBlockMap
, genBBlockMap
, analyseBBlocks
)
import Language.Fortran.Analysis.DataFlow
( InOutMap
, dataFlowSolver
, revPostOrder
)
import qualified Data.Map as M
import qualified Data.IntMap as IM
import Data.List ( foldl' )
import Data.Graph.Inductive.Graph ( Node
, lab
, pre
, labNodes
)
import Data.Data ( Data )
import Data.Generics.Uniplate.Data
import Data.Maybe ( maybeToList
, fromMaybe
, fromJust
)
type ValueOf a = Expression (Analysis a) -> CPValue
type MemoryTable = M.Map Range CPValue
type MemoryTables = M.Map MemoryBlockName MemoryTable
type MemoryTablesMap = M.Map ProgramUnitName (InOutMap MemoryTables)
extractSubstringBounds
:: SymbolTable
-> MemoryTables
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Int
-> Maybe (Int, Int)
SymbolTable
symTable MemoryTables
memTables Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me Offset
l =
let f :: Offset -> Maybe (Expression (Analysis a)) -> Maybe Offset
f Offset
d Maybe (Expression (Analysis a))
m = case Maybe (Expression (Analysis a))
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Expression (Analysis a)
v -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
v of
Maybe CPValue
Nothing -> forall a. a -> Maybe a
Just Offset
d
Just (Const (Int Offset
v)) -> forall a. a -> Maybe a
Just Offset
v
Just CPValue
_ -> forall a. Maybe a
Nothing
in case (Offset -> Maybe (Expression (Analysis a)) -> Maybe Offset
f Offset
1 Maybe (Expression (Analysis a))
mb, Offset -> Maybe (Expression (Analysis a)) -> Maybe Offset
f Offset
l Maybe (Expression (Analysis a))
me) of
(Just Offset
b, Just Offset
e) -> forall a. a -> Maybe a
Just (Offset
b, Offset
e)
(Maybe Offset, Maybe Offset)
_ -> forall a. Maybe a
Nothing
substringCPValue
:: SymbolTable
-> MemoryTables
-> Expression (Analysis a)
-> [Index (Analysis a)]
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> CPValue
substringCPValue :: forall a.
SymbolTable
-> MemoryTables
-> Expression (Analysis a)
-> [Index (Analysis a)]
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> CPValue
substringCPValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
e [Index (Analysis a)]
is Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me =
let name :: MemoryBlockName
name = forall a. Expression (Analysis a) -> MemoryBlockName
srcName Expression (Analysis a)
e
isArraySection :: Bool
isArraySection = case forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
name SymbolTable
symTable of
(SVariable (TArray SemType
_ Dimensions
dims) Location
_) -> forall (t :: * -> *) a. Foldable t => t a -> Offset
length [Index (Analysis a)]
is forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => Dims t a -> Offset
dimsLength Dimensions
dims
SymbolTableEntry
_ -> Bool
False
in if Bool
isArraySection
then forall {a}. a
errArraySection
else case forall a.
SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> CPValue
lookupArray SymbolTable
symTable MemoryTables
memTables MemoryBlockName
name [Index (Analysis a)]
is of
CPValue
Top -> CPValue
Top
CPValue
Bot -> CPValue
Bot
Const (Str MemoryBlockName
s) ->
case forall a.
SymbolTable
-> MemoryTables
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Offset
-> Maybe Range
extractSubstringBounds SymbolTable
symTable MemoryTables
memTables Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Offset
length MemoryBlockName
s of
Just (Offset
b', Offset
e') ->
ExpVal -> CPValue
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoryBlockName -> ExpVal
Str forall a b. (a -> b) -> a -> b
$ forall a. Offset -> [a] -> [a]
take (Offset
e' forall a. Num a => a -> a -> a
- Offset
b' forall a. Num a => a -> a -> a
+ Offset
1) forall a b. (a -> b) -> a -> b
$ forall a. Offset -> [a] -> [a]
drop (Offset
b' forall a. Num a => a -> a -> a
- Offset
1) MemoryBlockName
s
Maybe Range
Nothing -> CPValue
Bot
CPValue
_ -> forall {a}. a
errArraySection
where
errArraySection :: a
errArraySection = forall a. HasCallStack => MemoryBlockName -> a
error MemoryBlockName
"Array sections are not allowed in FORTRAN 77"
cpValue :: SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue :: forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
expr = case Expression (Analysis a)
expr of
ExpValue Analysis a
_ SrcSpan
_ ValVariable{} -> SymbolTable -> MemoryTables -> MemoryBlockName -> CPValue
lookupName SymbolTable
symTable MemoryTables
memTables forall a b. (a -> b) -> a -> b
$ forall a. Expression (Analysis a) -> MemoryBlockName
srcName Expression (Analysis a)
expr
ExpValue Analysis a
_ SrcSpan
s Value (Analysis a)
val -> ExpVal -> CPValue
Const (forall a. SrcSpan -> Value a -> ExpVal
valueToExpVal SrcSpan
s Value (Analysis a)
val)
ExpUnary Analysis a
_ SrcSpan
_ UnaryOp
op Expression (Analysis a)
e -> let v :: CPValue
v = forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
e in UnaryOp -> CPValue -> CPValue
unaryOper UnaryOp
op CPValue
v
ExpBinary Analysis a
_ SrcSpan
_ BinaryOp
op Expression (Analysis a)
e1 Expression (Analysis a)
e2 ->
let v1 :: CPValue
v1 = forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
e1
v2 :: CPValue
v2 = forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
e2
in BinaryOp -> CPValue -> CPValue -> CPValue
binaryOper BinaryOp
op CPValue
v1 CPValue
v2
ExpSubscript Analysis a
_ SrcSpan
_ e :: Expression (Analysis a)
e@ExpValue{} (AList Analysis a
_ SrcSpan
_ [IxRange Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me Maybe (Expression (Analysis a))
_]) ->
forall a.
SymbolTable
-> MemoryTables
-> Expression (Analysis a)
-> [Index (Analysis a)]
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> CPValue
substringCPValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
e [] Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me
ExpSubscript Analysis a
_ SrcSpan
_ e :: Expression (Analysis a)
e@ExpValue{} AList Index (Analysis a)
is ->
forall a.
SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> CPValue
lookupArray SymbolTable
symTable MemoryTables
memTables (forall a. Expression (Analysis a) -> MemoryBlockName
srcName Expression (Analysis a)
e) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Index (Analysis a)
is
ExpSubscript Analysis a
_ SrcSpan
_ (ExpSubscript Analysis a
_ SrcSpan
_ e :: Expression (Analysis a)
e@ExpValue{} AList Index (Analysis a)
is) (AList Analysis a
_ SrcSpan
_ [IxRange Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me Maybe (Expression (Analysis a))
_])
-> forall a.
SymbolTable
-> MemoryTables
-> Expression (Analysis a)
-> [Index (Analysis a)]
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> CPValue
substringCPValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
e (forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Index (Analysis a)
is) Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me
ExpFunctionCall{} -> CPValue
Bot
Expression (Analysis a)
_ -> forall a. HasCallStack => MemoryBlockName -> a
error forall a b. (a -> b) -> a -> b
$ MemoryBlockName
"Evaluation of the expression is not implemented - " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> MemoryBlockName
show
(forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
expr)
getVariableMemory :: SymbolTable -> Name -> Maybe (MemoryBlockName, Range)
getVariableMemory :: SymbolTable -> MemoryBlockName -> Maybe (MemoryBlockName, Range)
getVariableMemory SymbolTable
symTable MemoryBlockName
name = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
name SymbolTable
symTable of
Just (SVariable (TArray SemType
ty Dimensions
dims) (MemoryBlockName
memBlockName, Offset
offset)) -> do
Offset
kind <- SemType -> Maybe Offset
getTypeKind SemType
ty
case forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
Dims t (f a) -> f (Dims t a)
dimsTraverse Dimensions
dims of
Just (DimsExplicitShape NonEmpty (Dim Offset)
ds) ->
forall a. a -> Maybe a
Just (MemoryBlockName
memBlockName, (Offset
offset, Offset
offset forall a. Num a => a -> a -> a
+ forall (t :: * -> *).
Foldable t =>
Offset -> t (Dim Offset) -> Offset
sizeOfArray Offset
kind NonEmpty (Dim Offset)
ds forall a. Num a => a -> a -> a
- Offset
1))
Maybe (Dims NonEmpty Offset)
_ -> forall a. Maybe a
Nothing
Just (SVariable SemType
ty (MemoryBlockName
memBlockName, Offset
offset)) -> do
Offset
kind <- SemType -> Maybe Offset
getTypeKind SemType
ty
forall a. a -> Maybe a
Just (MemoryBlockName
memBlockName, (Offset
offset, Offset
offset forall a. Num a => a -> a -> a
+ Offset
kind forall a. Num a => a -> a -> a
- Offset
1))
Just SParameter{} -> forall a. Maybe a
Nothing
Just SDummy{} -> forall a. Maybe a
Nothing
Maybe SymbolTableEntry
Nothing -> forall a. Maybe a
Nothing
Maybe SymbolTableEntry
_ -> forall a. HasCallStack => MemoryBlockName -> a
error forall a b. (a -> b) -> a -> b
$ MemoryBlockName
"getVariableMemory - not a variable : " forall a. [a] -> [a] -> [a]
++ MemoryBlockName
name
unsafeStripIndexCP :: CPValue -> Int
unsafeStripIndexCP :: CPValue -> Offset
unsafeStripIndexCP (Const (Int Offset
i)) = Offset
i
unsafeStripIndexCP CPValue
_ = forall a. HasCallStack => MemoryBlockName -> a
error MemoryBlockName
"Expected no Top, Bot, nor non Int values"
data ArrayMemory
= UnknownIndices (MemoryBlockName, Range)
| ConstantIndices (MemoryBlockName, Range)
getArrayMemory
:: SymbolTable
-> MemoryTables
-> Name
-> [Index (Analysis a)]
-> Maybe ArrayMemory
getArrayMemory :: forall a.
SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> Maybe ArrayMemory
getArrayMemory SymbolTable
symTable MemoryTables
memTables MemoryBlockName
name [Index (Analysis a)]
indices =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
name SymbolTable
symTable of
Maybe SymbolTableEntry
Nothing -> forall a. HasCallStack => MemoryBlockName -> a
error forall a b. (a -> b) -> a -> b
$ MemoryBlockName
"variable not in symbol table: "forall a. Semigroup a => a -> a -> a
<>MemoryBlockName
name
Just SymbolTableEntry
entry ->
case SymbolTableEntry
entry of
SVariable SemType
ty (MemoryBlockName
memBlockName, Offset
start) ->
case SemType
ty of
TArray SemType
_ Dimensions
dims' ->
case forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
Dims t (f a) -> f (Dims t a)
dimsTraverse Dimensions
dims' of
Just (DimsExplicitShape NonEmpty (Dim Offset)
dims)
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CPValue -> Bool
isBot [CPValue]
idxCPValues
-> (MemoryBlockName, Range) -> ArrayMemory
UnknownIndices forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemoryBlockName
memBlockName, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Range
arrayRange
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CPValue -> Bool
isTop [CPValue]
idxCPValues
-> (MemoryBlockName, Range) -> ArrayMemory
UnknownIndices forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemoryBlockName
memBlockName, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Range
arrayRange
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CPValue -> Bool
isConstInt [CPValue]
idxCPValues)
-> (MemoryBlockName, Range) -> ArrayMemory
UnknownIndices forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemoryBlockName
memBlockName, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Range
arrayRange
| Bool
otherwise
-> do
let is :: [Offset]
is = forall a b. (a -> b) -> [a] -> [b]
map CPValue -> Offset
unsafeStripIndexCP [CPValue]
idxCPValues
Range
range <- forall (t :: * -> *).
(Functor t, Foldable t) =>
[Offset] -> Offset -> t (Dim Offset) -> Offset -> Range
generateLinearizedIndexRange [Offset]
is Offset
start forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty (Dim Offset)
dims forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Offset
kind
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (MemoryBlockName, Range) -> ArrayMemory
ConstantIndices (MemoryBlockName
memBlockName, Range
range)
where
kind :: Maybe Offset
kind = SemType -> Maybe Offset
getTypeKind SemType
ty
size :: Maybe Offset
size = forall (t :: * -> *).
Foldable t =>
Offset -> t (Dim Offset) -> Offset
sizeOfArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Offset
kind forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty (Dim Offset)
dims
arrayRange :: Maybe Range
arrayRange = (\Offset
x -> (Offset
start, Offset
start forall a. Num a => a -> a -> a
+ Offset
x forall a. Num a => a -> a -> a
- Offset
1)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Offset
size
Just{} -> forall a. Maybe a
Nothing
Maybe (Dims NonEmpty Offset)
Nothing -> forall a. Maybe a
Nothing
SemType
_
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Index (Analysis a)]
indices -> (MemoryBlockName, Range) -> ArrayMemory
ConstantIndices forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemoryBlockName
memBlockName, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Range
range
| Bool
otherwise -> (MemoryBlockName, Range) -> ArrayMemory
UnknownIndices forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemoryBlockName
memBlockName, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Range
range
where
kind :: Maybe Offset
kind = SemType -> Maybe Offset
getTypeKind SemType
ty
range :: Maybe Range
range = (\Offset
x -> (Offset
start, Offset
start forall a. Num a => a -> a -> a
+ Offset
x forall a. Num a => a -> a -> a
- Offset
1)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Offset
kind
SymbolTableEntry
_ -> forall a. Maybe a
Nothing
where
idxCPValues :: [CPValue]
idxCPValues = forall a.
SymbolTable -> MemoryTables -> [Index (Analysis a)] -> [CPValue]
cpValueOfIndices SymbolTable
symTable MemoryTables
memTables [Index (Analysis a)]
indices
lookupName :: SymbolTable -> MemoryTables -> Name -> CPValue
lookupName :: SymbolTable -> MemoryTables -> MemoryBlockName -> CPValue
lookupName SymbolTable
symTable MemoryTables
memTables MemoryBlockName
name = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
name SymbolTable
symTable of
Just (SParameter SemType
_ ExpVal
val) -> ExpVal -> CPValue
Const ExpVal
val
Just (SVariable SemType
ty Location
loc) -> MemoryTables -> SemType -> Location -> CPValue
lookupScalarVariable MemoryTables
memTables SemType
ty Location
loc
Just SDummy{} -> CPValue
Bot
Just SExternal{} -> CPValue
Bot
Maybe SymbolTableEntry
Nothing -> CPValue
Bot
lookupScalarVariable :: MemoryTables -> Type -> Location -> CPValue
lookupScalarVariable :: MemoryTables -> SemType -> Location -> CPValue
lookupScalarVariable MemoryTables
memTables SemType
ty Location
loc =
let (MemoryBlockName
memBlockName, Offset
start) = Location
loc
mkind :: Maybe Offset
mkind = SemType -> Maybe Offset
getTypeKind SemType
ty
mrange :: Maybe Range
mrange = (\Offset
x -> (Offset
start, Offset
start forall a. Num a => a -> a -> a
+ Offset
x forall a. Num a => a -> a -> a
- Offset
1)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Offset
mkind
in case Maybe Range
mrange of
Just Range
range -> case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
memBlockName MemoryTables
memTables of
Just MemoryTable
memTbl -> Range -> MemoryTable -> CPValue
lookupRange Range
range MemoryTable
memTbl
Maybe MemoryTable
Nothing -> CPValue
Top
Maybe Range
Nothing -> CPValue
Bot
lookupArray
:: SymbolTable -> MemoryTables -> Name -> [Index (Analysis a)] -> CPValue
lookupArray :: forall a.
SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> CPValue
lookupArray SymbolTable
symTable MemoryTables
memTables MemoryBlockName
name [Index (Analysis a)]
indices =
case forall a.
SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> Maybe ArrayMemory
getArrayMemory SymbolTable
symTable MemoryTables
memTables MemoryBlockName
name [Index (Analysis a)]
indices of
Maybe ArrayMemory
Nothing -> CPValue
Bot
Just (UnknownIndices (MemoryBlockName, Range)
_) -> CPValue
Bot
Just (ConstantIndices (MemoryBlockName
memBlockName, Range
range)) ->
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
memBlockName MemoryTables
memTables of
Just MemoryTable
memTbl -> Range -> MemoryTable -> CPValue
lookupRange Range
range MemoryTable
memTbl
Maybe MemoryTable
Nothing -> CPValue
Top
cpValueOfIndices
:: SymbolTable -> MemoryTables -> [Index (Analysis a)] -> [CPValue]
cpValueOfIndices :: forall a.
SymbolTable -> MemoryTables -> [Index (Analysis a)] -> [CPValue]
cpValueOfIndices SymbolTable
symTable MemoryTables
memTables = forall a b. (a -> b) -> [a] -> [b]
map forall a. Index (Analysis a) -> CPValue
cpValueOfIndex
where
cpValueOfIndex :: Index (Analysis a) -> CPValue
cpValueOfIndex :: forall a. Index (Analysis a) -> CPValue
cpValueOfIndex (IxSingle Analysis a
_ SrcSpan
_ Maybe MemoryBlockName
_ Expression (Analysis a)
e) = forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
e
cpValueOfIndex Index (Analysis a)
_ = forall a. HasCallStack => MemoryBlockName -> a
error MemoryBlockName
"Array sections are not allowed in FORTRAN 77"
lookupRange :: Range -> MemoryTable -> CPValue
lookupRange :: Range -> MemoryTable -> CPValue
lookupRange Range
range MemoryTable
memTable = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Range
range MemoryTable
memTable of
Just CPValue
val -> CPValue
val
Maybe CPValue
Nothing | Range -> [Range] -> Bool
anyOverlap Range
range (forall k a. Map k a -> [k]
M.keys MemoryTable
memTable) -> CPValue
Bot
Maybe CPValue
_ -> CPValue
Top
constantPropagationAnalysis
:: ProgramUnitModel -> BBGr (Analysis a) -> InOutMap MemoryTables
constantPropagationAnalysis :: forall a.
ProgramUnitModel -> BBGr (Analysis a) -> InOutMap MemoryTables
constantPropagationAnalysis ProgramUnitModel
puModel BBGr (Analysis a)
gr = forall t a.
(NFData t, Ord t) =>
BBGr a
-> (Offset -> InOut t)
-> OrderF a
-> (OutF t -> OutF t)
-> (OutF t -> OutF t)
-> InOutMap t
dataFlowSolver
BBGr (Analysis a)
gr
(forall a b. a -> b -> a
const (forall k a. Map k a
M.empty, forall k a. Map k a
M.empty))
forall a. OrderF a
revPostOrder
(Offset -> MemoryTables) -> Offset -> MemoryTables
inn
(Offset -> MemoryTables) -> Offset -> MemoryTables
out
where
inn :: (Offset -> MemoryTables) -> Offset -> MemoryTables
inn Offset -> MemoryTables
outF Offset
b =
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith CPValue -> CPValue -> CPValue
meet) [ Offset -> MemoryTables
outF Offset
s | Offset
s <- forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Offset -> [Offset]
pre (forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Offset
b ]
out :: (Offset -> MemoryTables) -> Offset -> MemoryTables
out Offset -> MemoryTables
innF Offset
b = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a.
ProgramUnitModel
-> MemoryTables -> Block (Analysis a) -> MemoryTables
varDefine ProgramUnitModel
puModel)
(Offset -> MemoryTables
innF Offset
b)
(forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
"constantPropagation" forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Offset -> Maybe a
lab (forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Offset
b)
updateRangeValue
:: MemoryTables -> MemoryBlockName -> Range -> CPValue -> Bool -> MemoryTables
updateRangeValue :: MemoryTables
-> MemoryBlockName -> Range -> CPValue -> Bool -> MemoryTables
updateRangeValue MemoryTables
memTables' MemoryBlockName
memBlockName Range
range CPValue
val Bool
filt =
let rangeMap :: MemoryTable
rangeMap = forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
M.empty forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
memBlockName MemoryTables
memTables'
rangeMap' :: MemoryTable
rangeMap' = if Bool
filt
then forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\Range
k CPValue
_ -> Bool -> Bool
not (Range -> Range -> Bool
overlap Range
k Range
range)) MemoryTable
rangeMap
else MemoryTable
rangeMap
newRangeMap :: MemoryTable
newRangeMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Range
range CPValue
val MemoryTable
rangeMap'
in forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert MemoryBlockName
memBlockName MemoryTable
newRangeMap MemoryTables
memTables'
substringDefine
:: SymbolTable
-> MemoryTables
-> Expression (Analysis a)
-> [Index (Analysis a)]
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Expression (Analysis a)
-> MemoryTables
substringDefine :: forall a.
SymbolTable
-> MemoryTables
-> Expression (Analysis a)
-> [Index (Analysis a)]
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Expression (Analysis a)
-> MemoryTables
substringDefine SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
e [Index (Analysis a)]
is Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me Expression (Analysis a)
rhs =
case forall a.
SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> Maybe ArrayMemory
getArrayMemory SymbolTable
symTable MemoryTables
memTables (forall a. Expression (Analysis a) -> MemoryBlockName
srcName Expression (Analysis a)
e) [Index (Analysis a)]
is of
Maybe ArrayMemory
Nothing -> MemoryTables
memTables
Just (UnknownIndices (MemoryBlockName
memBlockName, Range
wholeArrayRange)) ->
let val :: CPValue
val = CPValue
Bot
in MemoryTables
-> MemoryBlockName -> Range -> CPValue -> Bool -> MemoryTables
updateRangeValue MemoryTables
memTables MemoryBlockName
memBlockName Range
wholeArrayRange CPValue
val Bool
True
Just (ConstantIndices (MemoryBlockName
memBlockName, Range
range)) ->
let val :: CPValue
val = forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
rhs
str :: CPValue
str = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
memBlockName MemoryTables
memTables of
Just MemoryTable
memTbl -> Range -> MemoryTable -> CPValue
lookupRange Range
range MemoryTable
memTbl
Maybe MemoryTable
Nothing -> CPValue
Top
val' :: CPValue
val' = case CPValue
val of
Const (Str MemoryBlockName
s) -> case CPValue
str of
Const (Str MemoryBlockName
o) ->
case
forall a.
SymbolTable
-> MemoryTables
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Offset
-> Maybe Range
extractSubstringBounds SymbolTable
symTable MemoryTables
memTables Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Offset
length MemoryBlockName
o
of
Just (Offset
b', Offset
e') ->
let s' :: MemoryBlockName
s' = MemoryBlockName
s forall a. [a] -> [a] -> [a]
++ forall a. Offset -> a -> [a]
replicate (Offset
e' forall a. Num a => a -> a -> a
- Offset
b' forall a. Num a => a -> a -> a
+ Offset
1 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Offset
length MemoryBlockName
s) Char
' '
in ExpVal -> CPValue
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoryBlockName -> ExpVal
Str forall a b. (a -> b) -> a -> b
$ forall a. Offset -> [a] -> [a]
take (Offset
b' forall a. Num a => a -> a -> a
- Offset
1) MemoryBlockName
o forall a. [a] -> [a] -> [a]
++ MemoryBlockName
s' forall a. [a] -> [a] -> [a]
++ forall a. Offset -> [a] -> [a]
drop Offset
e' MemoryBlockName
o
Maybe Range
Nothing -> CPValue
Bot
CPValue
_ -> CPValue
Bot
CPValue
_ -> CPValue
Bot
in MemoryTables
-> MemoryBlockName -> Range -> CPValue -> Bool -> MemoryTables
updateRangeValue MemoryTables
memTables MemoryBlockName
memBlockName Range
range CPValue
val' Bool
True
varDefine
:: ProgramUnitModel -> MemoryTables -> Block (Analysis a) -> MemoryTables
varDefine :: forall a.
ProgramUnitModel
-> MemoryTables -> Block (Analysis a) -> MemoryTables
varDefine (SymbolTable
symTable, StorageTable
storageTable) MemoryTables
memTables (BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ (StExpressionAssign Analysis a
_ SrcSpan
_ Expression (Analysis a)
lhs Expression (Analysis a)
rhs))
| expr :: Expression (Analysis a)
expr@(ExpValue Analysis a
_ SrcSpan
_ ValVariable{}) <- Expression (Analysis a)
lhs
, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Expression (Analysis a) -> Bool
inCommon Expression (Analysis a)
expr
= let name :: MemoryBlockName
name = forall a. Expression (Analysis a) -> MemoryBlockName
srcName Expression (Analysis a)
expr
in
case SymbolTable -> MemoryBlockName -> Maybe (MemoryBlockName, Range)
getVariableMemory SymbolTable
symTable MemoryBlockName
name of
Just (MemoryBlockName
memBlockName, range :: Range
range@(Offset
b, Offset
e)) ->
let val :: CPValue
val = forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
rhs
in
case forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
name SymbolTable
symTable of
SVariable (TArray SemType
ty Dimensions
_) Location
_ ->
let
kind :: Offset
kind =
forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => MemoryBlockName -> a
error forall a b. (a -> b) -> a -> b
$ MemoryBlockName
"Couldn't get kind of type " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> MemoryBlockName
show SemType
ty)
forall a b. (a -> b) -> a -> b
$ SemType -> Maybe Offset
getTypeKind SemType
ty
val' :: CPValue
val' = case CPValue
val of
Const (Str MemoryBlockName
s) -> ExpVal -> CPValue
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoryBlockName -> ExpVal
Str forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Offset -> a -> [a]
replicate Offset
kind forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null MemoryBlockName
s
then Char
' '
else forall a. [a] -> a
head MemoryBlockName
s
CPValue
_ -> CPValue
val
handler :: MemoryTables -> Range -> MemoryTables
handler MemoryTables
mt Range
range' =
MemoryTables
-> MemoryBlockName -> Range -> CPValue -> Bool -> MemoryTables
updateRangeValue MemoryTables
mt MemoryBlockName
memBlockName Range
range' CPValue
val' Bool
True
in
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' MemoryTables -> Range -> MemoryTables
handler
MemoryTables
memTables
[ (Offset
b', Offset
b' forall a. Num a => a -> a -> a
+ Offset
kind forall a. Num a => a -> a -> a
- Offset
1) | Offset
b' <- [Offset
b, Offset
b forall a. Num a => a -> a -> a
+ Offset
kind .. Offset
e] ]
SymbolTableEntry
_ -> MemoryTables
-> MemoryBlockName -> Range -> CPValue -> Bool -> MemoryTables
updateRangeValue MemoryTables
memTables MemoryBlockName
memBlockName Range
range CPValue
val Bool
True
Maybe (MemoryBlockName, Range)
Nothing -> MemoryTables
memTables
| ExpSubscript Analysis a
_ SrcSpan
_ e :: Expression (Analysis a)
e@ExpValue{} (AList Analysis a
_ SrcSpan
_ [IxRange Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me Maybe (Expression (Analysis a))
_]) <- Expression (Analysis a)
lhs
, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Expression (Analysis a) -> Bool
inCommon Expression (Analysis a)
e
= forall a.
SymbolTable
-> MemoryTables
-> Expression (Analysis a)
-> [Index (Analysis a)]
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Expression (Analysis a)
-> MemoryTables
substringDefine SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
e [] Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me Expression (Analysis a)
rhs
| ExpSubscript Analysis a
_ SrcSpan
_ e :: Expression (Analysis a)
e@ExpValue{} AList Index (Analysis a)
indices <- Expression (Analysis a)
lhs
, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Expression (Analysis a) -> Bool
inCommon Expression (Analysis a)
e
= case forall a.
SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> Maybe ArrayMemory
getArrayMemory SymbolTable
symTable MemoryTables
memTables (forall a. Expression (Analysis a) -> MemoryBlockName
srcName Expression (Analysis a)
e) (forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Index (Analysis a)
indices) of
Maybe ArrayMemory
Nothing -> MemoryTables
memTables
Just (UnknownIndices (MemoryBlockName
memBlockName, Range
wholeArrayRange)) ->
let val :: CPValue
val = CPValue
Bot
in MemoryTables
-> MemoryBlockName -> Range -> CPValue -> Bool -> MemoryTables
updateRangeValue MemoryTables
memTables MemoryBlockName
memBlockName Range
wholeArrayRange CPValue
val Bool
True
Just (ConstantIndices (MemoryBlockName
memBlockName, Range
range)) ->
let val :: CPValue
val = forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
rhs
in MemoryTables
-> MemoryBlockName -> Range -> CPValue -> Bool -> MemoryTables
updateRangeValue MemoryTables
memTables MemoryBlockName
memBlockName Range
range CPValue
val Bool
False
| ExpSubscript Analysis a
_ SrcSpan
_ (ExpSubscript Analysis a
_ SrcSpan
_ e :: Expression (Analysis a)
e@ExpValue{} AList Index (Analysis a)
is) (AList Analysis a
_ SrcSpan
_ [IxRange Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me Maybe (Expression (Analysis a))
_]) <-
Expression (Analysis a)
lhs
, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Expression (Analysis a) -> Bool
inCommon Expression (Analysis a)
e
= forall a.
SymbolTable
-> MemoryTables
-> Expression (Analysis a)
-> [Index (Analysis a)]
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Expression (Analysis a)
-> MemoryTables
substringDefine SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
e (forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Index (Analysis a)
is) Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me Expression (Analysis a)
rhs
| Bool
otherwise
= MemoryTables
memTables
where
inCommon :: Expression (Analysis a) -> Bool
inCommon :: forall a. Expression (Analysis a) -> Bool
inCommon Expression (Analysis a)
e = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a. Expression (Analysis a) -> MemoryBlockName
srcName Expression (Analysis a)
e) SymbolTable
symTable of
Just (SVariable SemType
_ (MemoryBlockName
memBlockName, Offset
_)) ->
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
memBlockName StorageTable
storageTable of
Just MemoryBlock
memBlock -> MemoryBlock -> StorageClass
storageClass MemoryBlock
memBlock forall a. Eq a => a -> a -> Bool
== StorageClass
Common
Maybe MemoryBlock
_ -> Bool
False
Maybe SymbolTableEntry
_ -> Bool
False
varDefine ProgramUnitModel
_ MemoryTables
memTables Block (Analysis a)
_ = MemoryTables
memTables
type ExpressionContext = (Node, Node, ProgramUnitName)
type ExpressionContextMap = M.Map SrcSpan ExpressionContext
lookupExpressionContext
:: Data a => Expression a -> ExpressionContextMap -> ExpressionContext
lookupExpressionContext :: forall a.
Data a =>
Expression a -> ExpressionContextMap -> ExpressionContext
lookupExpressionContext Expression a
expr ExpressionContextMap
exprCxtMap =
let s :: SrcSpan
s = forall a. Spanned a => a -> SrcSpan
getSpan Expression a
expr
err :: MemoryBlockName
err = MemoryBlockName
"Lookup Expression Context at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> MemoryBlockName
show SrcSpan
s
in forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
err forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SrcSpan
s ExpressionContextMap
exprCxtMap
genExpressionContextMap
:: Data a => BBlockMap (Analysis a) -> ExpressionContextMap
genExpressionContextMap :: forall a. Data a => BBlockMap (Analysis a) -> ExpressionContextMap
genExpressionContextMap BBlockMap (Analysis a)
bblockMap =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
forall a b. (a -> b) -> a -> b
$ [ (forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
expr, (Offset
bl, Offset
bbl, ProgramUnitName
pu))
| (ProgramUnitName
pu , BBGr (Analysis a)
gr ) <- forall k a. Map k a -> [(k, a)]
M.toList BBlockMap (Analysis a)
bblockMap
, (Offset
bbl, BB (Analysis a)
basicBlock) <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes (forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr)
, Block (Analysis a)
block <- BB (Analysis a)
basicBlock
, Offset
bl <- forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (b :: * -> *).
(Data a, Data (b (Analysis a)), Annotated b) =>
b (Analysis a) -> Maybe Offset
label forall a b. (a -> b) -> a -> b
$ Block (Analysis a)
block
, Expression (Analysis a)
expr <- forall a. Data a => Block (Analysis a) -> [Expression (Analysis a)]
allExp Block (Analysis a)
block
]
where
allExp :: Data a => Block (Analysis a) -> [Expression (Analysis a)]
allExp :: forall a. Data a => Block (Analysis a) -> [Expression (Analysis a)]
allExp = forall from to. Biplate from to => from -> [to]
universeBi
constantPropagationValuePU
:: Data a
=> ProgramUnitModel
-> BBGr (Analysis a)
-> InOutMap MemoryTables
-> ExpressionContext
-> Expression (Analysis a)
-> CPValue
constantPropagationValuePU :: forall a.
Data a =>
ProgramUnitModel
-> BBGr (Analysis a)
-> InOutMap MemoryTables
-> ExpressionContext
-> Expression (Analysis a)
-> CPValue
constantPropagationValuePU puModel :: ProgramUnitModel
puModel@(SymbolTable
symTable, StorageTable
_) BBGr (Analysis a)
gr InOutMap MemoryTables
memTables ExpressionContext
exprCxt Expression (Analysis a)
expr =
let
(Offset
expBlock, Offset
expBBlock, ProgramUnitName
_) = ExpressionContext
exprCxt
bblock :: BB (Analysis a)
bblock = forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
"Basic Block" forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Offset -> Maybe a
lab (forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Offset
expBBlock
precedingBlocks :: BB (Analysis a)
precedingBlocks = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Block (Analysis a)
b -> forall a. HasCallStack => Maybe a -> a
fromJust (forall a (b :: * -> *).
(Data a, Data (b (Analysis a)), Annotated b) =>
b (Analysis a) -> Maybe Offset
label Block (Analysis a)
b) forall a. Eq a => a -> a -> Bool
/= Offset
expBlock) BB (Analysis a)
bblock
inBBMemoryTables :: MemoryTables
inBBMemoryTables = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
"Cannot find MemoryTables" forall a b. (a -> b) -> a -> b
$ forall a. Offset -> IntMap a -> Maybe a
IM.lookup
Offset
expBBlock
InOutMap MemoryTables
memTables
inBlockMemoryTables :: MemoryTables
inBlockMemoryTables =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a.
ProgramUnitModel
-> MemoryTables -> Block (Analysis a) -> MemoryTables
varDefine ProgramUnitModel
puModel) MemoryTables
inBBMemoryTables BB (Analysis a)
precedingBlocks
in
forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
inBlockMemoryTables Expression (Analysis a)
expr
constantPropagationValuePF
:: Data a
=> ProgramFileModel
-> BBlockMap (Analysis a)
-> MemoryTablesMap
-> ExpressionContextMap
-> Expression (Analysis a)
-> CPValue
constantPropagationValuePF :: forall a.
Data a =>
ProgramFileModel
-> BBlockMap (Analysis a)
-> MemoryTablesMap
-> ExpressionContextMap
-> Expression (Analysis a)
-> CPValue
constantPropagationValuePF ProgramFileModel
pfModel BBlockMap (Analysis a)
bbgraphs MemoryTablesMap
memTablesMap ExpressionContextMap
exprCtxMap Expression (Analysis a)
expr =
let exprCtx :: ExpressionContext
exprCtx@(Offset
_, Offset
_, ProgramUnitName
unitName) = forall a.
Data a =>
Expression a -> ExpressionContextMap -> ExpressionContext
lookupExpressionContext Expression (Analysis a)
expr ExpressionContextMap
exprCtxMap
puModel :: ProgramUnitModel
puModel = forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
"Find SymbolTable" forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ProgramUnitName
unitName ProgramFileModel
pfModel
controlFlowGraph :: BBGr (Analysis a)
controlFlowGraph =
forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
"Find basic block graph" forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ProgramUnitName
unitName BBlockMap (Analysis a)
bbgraphs
memTables :: InOutMap MemoryTables
memTables = forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
"Find MemTables" forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ProgramUnitName
unitName MemoryTablesMap
memTablesMap
in forall a.
Data a =>
ProgramUnitModel
-> BBGr (Analysis a)
-> InOutMap MemoryTables
-> ExpressionContext
-> Expression (Analysis a)
-> CPValue
constantPropagationValuePU ProgramUnitModel
puModel BBGr (Analysis a)
controlFlowGraph InOutMap MemoryTables
memTables ExpressionContext
exprCtx Expression (Analysis a)
expr
constantPropagationValue :: Data a => ProgramFile (Analysis a) -> ValueOf a
constantPropagationValue :: forall a. Data a => ProgramFile (Analysis a) -> ValueOf a
constantPropagationValue ProgramFile (Analysis a)
pf =
let pfb :: ProgramFile (Analysis a)
pfb = forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseBBlocks ProgramFile (Analysis a)
pf
pfModel :: ProgramFileModel
pfModel = forall a. Data a => ProgramFile (Analysis a) -> ProgramFileModel
programFileModel ProgramFile (Analysis a)
pfb
bbgraphs :: BBlockMap (Analysis a)
bbgraphs = forall a.
Data a =>
ProgramFile (Analysis a) -> BBlockMap (Analysis a)
genBBlockMap ProgramFile (Analysis a)
pfb
mapFunc :: ProgramUnitName -> BBGr (Analysis a) -> InOutMap MemoryTables
mapFunc ProgramUnitName
puName BBGr (Analysis a)
controlFlowGraph =
let puModel :: ProgramUnitModel
puModel =
forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
"Find ProgramUnitModel" forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ProgramUnitName
puName ProgramFileModel
pfModel
in forall a.
ProgramUnitModel -> BBGr (Analysis a) -> InOutMap MemoryTables
constantPropagationAnalysis ProgramUnitModel
puModel BBGr (Analysis a)
controlFlowGraph
memTablesMap :: MemoryTablesMap
memTablesMap = forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey ProgramUnitName -> BBGr (Analysis a) -> InOutMap MemoryTables
mapFunc BBlockMap (Analysis a)
bbgraphs
exprCtxMap :: ExpressionContextMap
exprCtxMap = forall a. Data a => BBlockMap (Analysis a) -> ExpressionContextMap
genExpressionContextMap BBlockMap (Analysis a)
bbgraphs
in forall a.
Data a =>
ProgramFileModel
-> BBlockMap (Analysis a)
-> MemoryTablesMap
-> ExpressionContextMap
-> Expression (Analysis a)
-> CPValue
constantPropagationValuePF ProgramFileModel
pfModel BBlockMap (Analysis a)
bbgraphs MemoryTablesMap
memTablesMap ExpressionContextMap
exprCtxMap
fromJustMsg :: String -> Maybe a -> a
fromJustMsg :: forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
_ (Just a
x) = a
x
fromJustMsg MemoryBlockName
msg Maybe a
_ = forall a. HasCallStack => MemoryBlockName -> a
error MemoryBlockName
msg
label
:: forall a b
. (Data a, Data (b (Analysis a)), Annotated b)
=> b (Analysis a)
-> Maybe Int
label :: forall a (b :: * -> *).
(Data a, Data (b (Analysis a)), Annotated b) =>
b (Analysis a) -> Maybe Offset
label = forall a. Analysis a -> Maybe Offset
insLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation
sizeOfArray :: Foldable t => Int -> t (Dim Int) -> Int
sizeOfArray :: forall (t :: * -> *).
Foldable t =>
Offset -> t (Dim Offset) -> Offset
sizeOfArray Offset
kind t (Dim Offset)
dims = Offset
kind forall a. Num a => a -> a -> a
* Offset
arraySize
where
arraySize :: Offset
arraySize = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Offset
acc (Dim Offset
l Offset
h) -> Offset
acc forall a. Num a => a -> a -> a
* (Offset
h forall a. Num a => a -> a -> a
- Offset
l forall a. Num a => a -> a -> a
+ Offset
1)) Offset
1 t (Dim Offset)
dims