{-# 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.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 Int
l =
let f :: Int -> Maybe (Expression (Analysis a)) -> Maybe Int
f Int
d Maybe (Expression (Analysis a))
m = case Maybe (Expression (Analysis a))
m Maybe (Expression (Analysis a))
-> (Expression (Analysis a) -> Maybe CPValue) -> Maybe CPValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Expression (Analysis a)
v -> CPValue -> Maybe CPValue
forall a. a -> Maybe a
Just (CPValue -> Maybe CPValue) -> CPValue -> Maybe CPValue
forall a b. (a -> b) -> a -> b
$ SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
v of
Maybe CPValue
Nothing -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
d
Just (Const (Int Int
v)) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
v
Just CPValue
_ -> Maybe Int
forall a. Maybe a
Nothing
in case (Int -> Maybe (Expression (Analysis a)) -> Maybe Int
forall {a}. Int -> Maybe (Expression (Analysis a)) -> Maybe Int
f Int
1 Maybe (Expression (Analysis a))
mb, Int -> Maybe (Expression (Analysis a)) -> Maybe Int
forall {a}. Int -> Maybe (Expression (Analysis a)) -> Maybe Int
f Int
l Maybe (Expression (Analysis a))
me) of
(Just Int
b, Just Int
e) -> Range -> Maybe Range
forall a. a -> Maybe a
Just (Int
b, Int
e)
(Maybe Int, Maybe Int)
_ -> Maybe Range
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 errStr :: MemoryBlockName
errStr = MemoryBlockName
"Array sections are not allowed in FORTRAN 77"
name :: MemoryBlockName
name = Expression (Analysis a) -> MemoryBlockName
forall a. Expression (Analysis a) -> MemoryBlockName
srcName Expression (Analysis a)
e
isArraySection :: Bool
isArraySection = case Maybe SymbolTableEntry -> SymbolTableEntry
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe SymbolTableEntry -> SymbolTableEntry)
-> Maybe SymbolTableEntry -> SymbolTableEntry
forall a b. (a -> b) -> a -> b
$ MemoryBlockName -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
name SymbolTable
symTable of
(SVariable (TArray SemType
_ Maybe Dimensions
dims) Location
_) -> [Index (Analysis a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Index (Analysis a)]
is Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Maybe Dimensions -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Maybe Dimensions
dims
SymbolTableEntry
_ -> Bool
False
in if Bool
isArraySection
then MemoryBlockName -> CPValue
forall a. HasCallStack => MemoryBlockName -> a
error MemoryBlockName
errStr
else case SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> CPValue
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 SymbolTable
-> MemoryTables
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Int
-> Maybe Range
forall a.
SymbolTable
-> MemoryTables
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Int
-> Maybe Range
extractSubstringBounds SymbolTable
symTable MemoryTables
memTables Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me (Int -> Maybe Range) -> Int -> Maybe Range
forall a b. (a -> b) -> a -> b
$ MemoryBlockName -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MemoryBlockName
s of
Just (Int
b', Int
e') ->
ExpVal -> CPValue
Const (ExpVal -> CPValue)
-> (MemoryBlockName -> ExpVal) -> MemoryBlockName -> CPValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoryBlockName -> ExpVal
Str (MemoryBlockName -> CPValue) -> MemoryBlockName -> CPValue
forall a b. (a -> b) -> a -> b
$ Int -> MemoryBlockName -> MemoryBlockName
forall a. Int -> [a] -> [a]
take (Int
e' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (MemoryBlockName -> MemoryBlockName)
-> MemoryBlockName -> MemoryBlockName
forall a b. (a -> b) -> a -> b
$ Int -> MemoryBlockName -> MemoryBlockName
forall a. Int -> [a] -> [a]
drop (Int
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MemoryBlockName
s
Maybe Range
Nothing -> CPValue
Bot
CPValue
_ -> MemoryBlockName -> CPValue
forall a. HasCallStack => MemoryBlockName -> a
error MemoryBlockName
errStr
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 (MemoryBlockName -> CPValue) -> MemoryBlockName -> CPValue
forall a b. (a -> b) -> a -> b
$ Expression (Analysis a) -> MemoryBlockName
forall a. Expression (Analysis a) -> MemoryBlockName
srcName Expression (Analysis a)
expr
ExpValue Analysis a
_ SrcSpan
s Value (Analysis a)
val -> ExpVal -> CPValue
Const (SrcSpan -> Value (Analysis a) -> ExpVal
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 = SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
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 = SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
e1
v2 :: CPValue
v2 = SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
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))
_]) ->
SymbolTable
-> MemoryTables
-> Expression (Analysis a)
-> [Index (Analysis a)]
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> CPValue
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 ->
SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> CPValue
forall a.
SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> CPValue
lookupArray SymbolTable
symTable MemoryTables
memTables (Expression (Analysis a) -> MemoryBlockName
forall a. Expression (Analysis a) -> MemoryBlockName
srcName Expression (Analysis a)
e) ([Index (Analysis a)] -> CPValue)
-> [Index (Analysis a)] -> CPValue
forall a b. (a -> b) -> a -> b
$ AList Index (Analysis a) -> [Index (Analysis a)]
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))
_])
-> SymbolTable
-> MemoryTables
-> Expression (Analysis a)
-> [Index (Analysis a)]
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> CPValue
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 (AList Index (Analysis a) -> [Index (Analysis a)]
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)
_ -> MemoryBlockName -> CPValue
forall a. HasCallStack => MemoryBlockName -> a
error (MemoryBlockName -> CPValue) -> MemoryBlockName -> CPValue
forall a b. (a -> b) -> a -> b
$ MemoryBlockName
"Evaluation of the expression is not implemented - " MemoryBlockName -> MemoryBlockName -> MemoryBlockName
forall a. [a] -> [a] -> [a]
++ SrcSpan -> MemoryBlockName
forall a. Show a => a -> MemoryBlockName
show
(Expression (Analysis a) -> SrcSpan
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 MemoryBlockName -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
name SymbolTable
symTable of
Just (SVariable (TArray SemType
ty Maybe Dimensions
dims) (MemoryBlockName
memBlockName, Int
offset)) -> do
Int
kind <- SemType -> Maybe Int
getTypeKind SemType
ty
Dimensions
dims' <- Maybe Dimensions
dims
(MemoryBlockName, Range) -> Maybe (MemoryBlockName, Range)
forall a. a -> Maybe a
Just (MemoryBlockName
memBlockName, (Int
offset, Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Dimensions -> Int
sizeOfArray Int
kind Dimensions
dims' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
Just (SVariable SemType
ty (MemoryBlockName
memBlockName, Int
offset)) -> do
Int
kind <- SemType -> Maybe Int
getTypeKind SemType
ty
(MemoryBlockName, Range) -> Maybe (MemoryBlockName, Range)
forall a. a -> Maybe a
Just (MemoryBlockName
memBlockName, (Int
offset, Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
kind Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
Just SParameter{} -> Maybe (MemoryBlockName, Range)
forall a. Maybe a
Nothing
Just SDummy{} -> Maybe (MemoryBlockName, Range)
forall a. Maybe a
Nothing
Maybe SymbolTableEntry
Nothing -> Maybe (MemoryBlockName, Range)
forall a. Maybe a
Nothing
Maybe SymbolTableEntry
_ -> MemoryBlockName -> Maybe (MemoryBlockName, Range)
forall a. HasCallStack => MemoryBlockName -> a
error (MemoryBlockName -> Maybe (MemoryBlockName, Range))
-> MemoryBlockName -> Maybe (MemoryBlockName, Range)
forall a b. (a -> b) -> a -> b
$ MemoryBlockName
"getVariableMemory - not a variable : " MemoryBlockName -> MemoryBlockName -> MemoryBlockName
forall a. [a] -> [a] -> [a]
++ MemoryBlockName
name
unsafeStripIndexCP :: CPValue -> Int
unsafeStripIndexCP :: CPValue -> Int
unsafeStripIndexCP (Const (Int Int
i)) = Int
i
unsafeStripIndexCP CPValue
_ = MemoryBlockName -> Int
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 =
let Just SymbolTableEntry
entry = MemoryBlockName -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
name SymbolTable
symTable
idxCPValues :: [CPValue]
idxCPValues = SymbolTable -> MemoryTables -> [Index (Analysis a)] -> [CPValue]
forall a.
SymbolTable -> MemoryTables -> [Index (Analysis a)] -> [CPValue]
cpValueOfIndices SymbolTable
symTable MemoryTables
memTables [Index (Analysis a)]
indices
in case SymbolTableEntry
entry of
SVariable (TArray SemType
ty Maybe Dimensions
dims) (MemoryBlockName
memBlockName, Int
start)
| (CPValue -> Bool) -> [CPValue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CPValue -> Bool
isBot [CPValue]
idxCPValues
-> (MemoryBlockName, Range) -> ArrayMemory
UnknownIndices ((MemoryBlockName, Range) -> ArrayMemory)
-> (Range -> (MemoryBlockName, Range)) -> Range -> ArrayMemory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemoryBlockName
memBlockName, ) (Range -> ArrayMemory) -> Maybe Range -> Maybe ArrayMemory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Range
arrayRange
| (CPValue -> Bool) -> [CPValue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CPValue -> Bool
isTop [CPValue]
idxCPValues
-> (MemoryBlockName, Range) -> ArrayMemory
UnknownIndices ((MemoryBlockName, Range) -> ArrayMemory)
-> (Range -> (MemoryBlockName, Range)) -> Range -> ArrayMemory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemoryBlockName
memBlockName, ) (Range -> ArrayMemory) -> Maybe Range -> Maybe ArrayMemory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Range
arrayRange
| Bool -> Bool
not ((CPValue -> Bool) -> [CPValue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CPValue -> Bool
isConstInt [CPValue]
idxCPValues)
-> (MemoryBlockName, Range) -> ArrayMemory
UnknownIndices ((MemoryBlockName, Range) -> ArrayMemory)
-> (Range -> (MemoryBlockName, Range)) -> Range -> ArrayMemory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemoryBlockName
memBlockName, ) (Range -> ArrayMemory) -> Maybe Range -> Maybe ArrayMemory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Range
arrayRange
| Bool
otherwise
-> do
let is :: [Int]
is = (CPValue -> Int) -> [CPValue] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map CPValue -> Int
unsafeStripIndexCP [CPValue]
idxCPValues
Range
range <- [Int] -> Int -> Dimensions -> Int -> Range
generateLinearizedIndexRange [Int]
is Int
start (Dimensions -> Int -> Range)
-> Maybe Dimensions -> Maybe (Int -> Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Dimensions
dims Maybe (Int -> Range) -> Maybe Int -> Maybe Range
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
kind
ArrayMemory -> Maybe ArrayMemory
forall a. a -> Maybe a
Just (ArrayMemory -> Maybe ArrayMemory)
-> ArrayMemory -> Maybe ArrayMemory
forall a b. (a -> b) -> a -> b
$ (MemoryBlockName, Range) -> ArrayMemory
ConstantIndices (MemoryBlockName
memBlockName, Range
range)
where
kind :: Maybe Int
kind = SemType -> Maybe Int
getTypeKind SemType
ty
size :: Maybe Int
size = Int -> Dimensions -> Int
sizeOfArray (Int -> Dimensions -> Int)
-> Maybe Int -> Maybe (Dimensions -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
kind Maybe (Dimensions -> Int) -> Maybe Dimensions -> Maybe Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Dimensions
dims
arrayRange :: Maybe Range
arrayRange = (\Int
x -> (Int
start, Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Int -> Range) -> Maybe Int -> Maybe Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
size
SVariable SemType
ty (MemoryBlockName
memBlockName, Int
start)
| [Index (Analysis a)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Index (Analysis a)]
indices -> (MemoryBlockName, Range) -> ArrayMemory
ConstantIndices ((MemoryBlockName, Range) -> ArrayMemory)
-> (Range -> (MemoryBlockName, Range)) -> Range -> ArrayMemory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemoryBlockName
memBlockName, ) (Range -> ArrayMemory) -> Maybe Range -> Maybe ArrayMemory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Range
range
| Bool
otherwise -> (MemoryBlockName, Range) -> ArrayMemory
UnknownIndices ((MemoryBlockName, Range) -> ArrayMemory)
-> (Range -> (MemoryBlockName, Range)) -> Range -> ArrayMemory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemoryBlockName
memBlockName, ) (Range -> ArrayMemory) -> Maybe Range -> Maybe ArrayMemory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Range
range
where
kind :: Maybe Int
kind = SemType -> Maybe Int
getTypeKind SemType
ty
range :: Maybe Range
range = (\Int
x -> (Int
start, Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Int -> Range) -> Maybe Int -> Maybe Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
kind
SymbolTableEntry
_ -> Maybe ArrayMemory
forall a. Maybe a
Nothing
lookupName :: SymbolTable -> MemoryTables -> Name -> CPValue
lookupName :: SymbolTable -> MemoryTables -> MemoryBlockName -> CPValue
lookupName SymbolTable
symTable MemoryTables
memTables MemoryBlockName
name = case MemoryBlockName -> SymbolTable -> Maybe SymbolTableEntry
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, Int
start) = Location
loc
mkind :: Maybe Int
mkind = SemType -> Maybe Int
getTypeKind SemType
ty
mrange :: Maybe Range
mrange = (\Int
x -> (Int
start, Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Int -> Range) -> Maybe Int -> Maybe Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mkind
in case Maybe Range
mrange of
Just Range
range -> case MemoryBlockName -> MemoryTables -> Maybe MemoryTable
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 SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> Maybe ArrayMemory
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 MemoryBlockName -> MemoryTables -> Maybe MemoryTable
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 = (Index (Analysis a) -> CPValue)
-> [Index (Analysis a)] -> [CPValue]
forall a b. (a -> b) -> [a] -> [b]
map Index (Analysis a) -> CPValue
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) = SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
e
cpValueOfIndex Index (Analysis a)
_ = MemoryBlockName -> CPValue
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 Range -> MemoryTable -> Maybe CPValue
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 -> Dimensions -> Bool
anyOverlap Range
range (MemoryTable -> Dimensions
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 = BBGr (Analysis a)
-> (Int -> InOut MemoryTables)
-> OrderF (Analysis a)
-> (OutF MemoryTables -> OutF MemoryTables)
-> (OutF MemoryTables -> OutF MemoryTables)
-> InOutMap MemoryTables
forall t a.
(NFData t, Ord t) =>
BBGr a
-> (Int -> InOut t)
-> OrderF a
-> (OutF t -> OutF t)
-> (OutF t -> OutF t)
-> InOutMap t
dataFlowSolver
BBGr (Analysis a)
gr
(InOut MemoryTables -> Int -> InOut MemoryTables
forall a b. a -> b -> a
const (MemoryTables
forall k a. Map k a
M.empty, MemoryTables
forall k a. Map k a
M.empty))
OrderF (Analysis a)
forall a. OrderF a
revPostOrder
OutF MemoryTables -> OutF MemoryTables
forall {k} {k}.
(Ord k, Ord k) =>
(Int -> Map k (Map k CPValue)) -> Int -> Map k (Map k CPValue)
inn
OutF MemoryTables -> OutF MemoryTables
out
where
inn :: (Int -> Map k (Map k CPValue)) -> Int -> Map k (Map k CPValue)
inn Int -> Map k (Map k CPValue)
outF Int
b =
(Map k CPValue -> Map k CPValue -> Map k CPValue)
-> [Map k (Map k CPValue)] -> Map k (Map k CPValue)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith ((CPValue -> CPValue -> CPValue)
-> Map k CPValue -> Map k CPValue -> Map k CPValue
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith CPValue -> CPValue -> CPValue
meet) [ Int -> Map k (Map k CPValue)
outF Int
s | Int
s <- Gr (BB (Analysis a)) () -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
pre (BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
b ]
out :: OutF MemoryTables -> OutF MemoryTables
out OutF MemoryTables
innF Int
b = (MemoryTables -> Block (Analysis a) -> MemoryTables)
-> MemoryTables -> BB (Analysis a) -> MemoryTables
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (ProgramUnitModel
-> MemoryTables -> Block (Analysis a) -> MemoryTables
forall a.
ProgramUnitModel
-> MemoryTables -> Block (Analysis a) -> MemoryTables
varDefine ProgramUnitModel
puModel)
(OutF MemoryTables
innF Int
b)
(MemoryBlockName -> Maybe (BB (Analysis a)) -> BB (Analysis a)
forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
"constantPropagation" (Maybe (BB (Analysis a)) -> BB (Analysis a))
-> Maybe (BB (Analysis a)) -> BB (Analysis a)
forall a b. (a -> b) -> a -> b
$ Gr (BB (Analysis a)) () -> Int -> Maybe (BB (Analysis a))
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
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 = MemoryTable -> Maybe MemoryTable -> MemoryTable
forall a. a -> Maybe a -> a
fromMaybe MemoryTable
forall k a. Map k a
M.empty (Maybe MemoryTable -> MemoryTable)
-> Maybe MemoryTable -> MemoryTable
forall a b. (a -> b) -> a -> b
$ MemoryBlockName -> MemoryTables -> Maybe MemoryTable
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
memBlockName MemoryTables
memTables'
rangeMap' :: MemoryTable
rangeMap' = if Bool
filt
then (Range -> CPValue -> Bool) -> MemoryTable -> MemoryTable
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 = Range -> CPValue -> MemoryTable -> MemoryTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Range
range CPValue
val MemoryTable
rangeMap'
in MemoryBlockName -> MemoryTable -> MemoryTables -> MemoryTables
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 SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> Maybe ArrayMemory
forall a.
SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> Maybe ArrayMemory
getArrayMemory SymbolTable
symTable MemoryTables
memTables (Expression (Analysis a) -> MemoryBlockName
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 = SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
rhs
str :: CPValue
str = case MemoryBlockName -> MemoryTables -> Maybe MemoryTable
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
SymbolTable
-> MemoryTables
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Int
-> Maybe Range
forall a.
SymbolTable
-> MemoryTables
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Int
-> Maybe Range
extractSubstringBounds SymbolTable
symTable MemoryTables
memTables Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me (Int -> Maybe Range) -> Int -> Maybe Range
forall a b. (a -> b) -> a -> b
$ MemoryBlockName -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MemoryBlockName
o
of
Just (Int
b', Int
e') ->
let s' :: MemoryBlockName
s' = MemoryBlockName
s MemoryBlockName -> MemoryBlockName -> MemoryBlockName
forall a. [a] -> [a] -> [a]
++ Int -> Char -> MemoryBlockName
forall a. Int -> a -> [a]
replicate (Int
e' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- MemoryBlockName -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MemoryBlockName
s) Char
' '
in ExpVal -> CPValue
Const (ExpVal -> CPValue)
-> (MemoryBlockName -> ExpVal) -> MemoryBlockName -> CPValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoryBlockName -> ExpVal
Str (MemoryBlockName -> CPValue) -> MemoryBlockName -> CPValue
forall a b. (a -> b) -> a -> b
$ Int -> MemoryBlockName -> MemoryBlockName
forall a. Int -> [a] -> [a]
take (Int
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MemoryBlockName
o MemoryBlockName -> MemoryBlockName -> MemoryBlockName
forall a. [a] -> [a] -> [a]
++ MemoryBlockName
s' MemoryBlockName -> MemoryBlockName -> MemoryBlockName
forall a. [a] -> [a] -> [a]
++ Int -> MemoryBlockName -> MemoryBlockName
forall a. Int -> [a] -> [a]
drop Int
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Expression (Analysis a) -> Bool
forall a. Expression (Analysis a) -> Bool
inCommon Expression (Analysis a)
expr
= let name :: MemoryBlockName
name = Expression (Analysis a) -> MemoryBlockName
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@(Int
b, Int
e)) ->
let val :: CPValue
val = SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
forall a.
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue SymbolTable
symTable MemoryTables
memTables Expression (Analysis a)
rhs
in
case Maybe SymbolTableEntry -> SymbolTableEntry
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe SymbolTableEntry -> SymbolTableEntry)
-> Maybe SymbolTableEntry -> SymbolTableEntry
forall a b. (a -> b) -> a -> b
$ MemoryBlockName -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MemoryBlockName
name SymbolTable
symTable of
SVariable (TArray SemType
ty Maybe Dimensions
_) Location
_ ->
let
kind :: Int
kind =
Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (MemoryBlockName -> Int
forall a. HasCallStack => MemoryBlockName -> a
error (MemoryBlockName -> Int) -> MemoryBlockName -> Int
forall a b. (a -> b) -> a -> b
$ MemoryBlockName
"Couldn't get kind of type " MemoryBlockName -> MemoryBlockName -> MemoryBlockName
forall a. Semigroup a => a -> a -> a
<> SemType -> MemoryBlockName
forall a. Show a => a -> MemoryBlockName
show SemType
ty)
(Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ SemType -> Maybe Int
getTypeKind SemType
ty
val' :: CPValue
val' = case CPValue
val of
Const (Str MemoryBlockName
s) -> ExpVal -> CPValue
Const (ExpVal -> CPValue) -> (Char -> ExpVal) -> Char -> CPValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoryBlockName -> ExpVal
Str (MemoryBlockName -> ExpVal)
-> (Char -> MemoryBlockName) -> Char -> ExpVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char -> MemoryBlockName
forall a. Int -> a -> [a]
replicate Int
kind (Char -> CPValue) -> Char -> CPValue
forall a b. (a -> b) -> a -> b
$ if MemoryBlockName -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null MemoryBlockName
s
then Char
' '
else MemoryBlockName -> Char
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
(MemoryTables -> Range -> MemoryTables)
-> MemoryTables -> Dimensions -> MemoryTables
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' MemoryTables -> Range -> MemoryTables
handler
MemoryTables
memTables
[ (Int
b', Int
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
kind Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) | Int
b' <- [Int
b, Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
kind .. Int
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Expression (Analysis a) -> Bool
forall a. Expression (Analysis a) -> Bool
inCommon Expression (Analysis a)
e
= SymbolTable
-> MemoryTables
-> Expression (Analysis a)
-> [Index (Analysis a)]
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Expression (Analysis a)
-> MemoryTables
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Expression (Analysis a) -> Bool
forall a. Expression (Analysis a) -> Bool
inCommon Expression (Analysis a)
e
= case SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> Maybe ArrayMemory
forall a.
SymbolTable
-> MemoryTables
-> MemoryBlockName
-> [Index (Analysis a)]
-> Maybe ArrayMemory
getArrayMemory SymbolTable
symTable MemoryTables
memTables (Expression (Analysis a) -> MemoryBlockName
forall a. Expression (Analysis a) -> MemoryBlockName
srcName Expression (Analysis a)
e) (AList Index (Analysis a) -> [Index (Analysis a)]
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 = SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Expression (Analysis a) -> Bool
forall a. Expression (Analysis a) -> Bool
inCommon Expression (Analysis a)
e
= SymbolTable
-> MemoryTables
-> Expression (Analysis a)
-> [Index (Analysis a)]
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Expression (Analysis a)
-> MemoryTables
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 (AList Index (Analysis a) -> [Index (Analysis a)]
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 MemoryBlockName -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Expression (Analysis a) -> MemoryBlockName
forall a. Expression (Analysis a) -> MemoryBlockName
srcName Expression (Analysis a)
e) SymbolTable
symTable of
Just (SVariable SemType
_ (MemoryBlockName
memBlockName, Int
_)) ->
case MemoryBlockName -> StorageTable -> Maybe MemoryBlock
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 StorageClass -> StorageClass -> Bool
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 = Expression a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression a
expr
err :: MemoryBlockName
err = MemoryBlockName
"Lookup Expression Context at " MemoryBlockName -> MemoryBlockName -> MemoryBlockName
forall a. [a] -> [a] -> [a]
++ SrcSpan -> MemoryBlockName
forall a. Show a => a -> MemoryBlockName
show SrcSpan
s
in MemoryBlockName -> Maybe ExpressionContext -> ExpressionContext
forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
err (Maybe ExpressionContext -> ExpressionContext)
-> Maybe ExpressionContext -> ExpressionContext
forall a b. (a -> b) -> a -> b
$ SrcSpan -> ExpressionContextMap -> Maybe ExpressionContext
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 =
[(SrcSpan, ExpressionContext)] -> ExpressionContextMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
([(SrcSpan, ExpressionContext)] -> ExpressionContextMap)
-> ([(SrcSpan, ExpressionContext)]
-> [(SrcSpan, ExpressionContext)])
-> [(SrcSpan, ExpressionContext)]
-> ExpressionContextMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SrcSpan, ExpressionContext)] -> [(SrcSpan, ExpressionContext)]
forall a. [a] -> [a]
reverse
([(SrcSpan, ExpressionContext)] -> ExpressionContextMap)
-> [(SrcSpan, ExpressionContext)] -> ExpressionContextMap
forall a b. (a -> b) -> a -> b
$ [ (Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
expr, (Int
bl, Int
bbl, ProgramUnitName
pu))
| (ProgramUnitName
pu , BBGr (Analysis a)
gr ) <- BBlockMap (Analysis a) -> [(ProgramUnitName, BBGr (Analysis a))]
forall k a. Map k a -> [(k, a)]
M.toList BBlockMap (Analysis a)
bblockMap
, (Int
bbl, BB (Analysis a)
basicBlock) <- Gr (BB (Analysis a)) () -> [(Int, BB (Analysis a))]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes (BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr)
, Block (Analysis a)
block <- BB (Analysis a)
basicBlock
, Int
bl <- Maybe Int -> [Int]
forall a. Maybe a -> [a]
maybeToList (Maybe Int -> [Int])
-> (Block (Analysis a) -> Maybe Int) -> Block (Analysis a) -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (Analysis a) -> Maybe Int
forall a (b :: * -> *).
(Data a, Data (b (Analysis a)), Annotated b) =>
b (Analysis a) -> Maybe Int
label (Block (Analysis a) -> [Int]) -> Block (Analysis a) -> [Int]
forall a b. (a -> b) -> a -> b
$ Block (Analysis a)
block
, Expression (Analysis a)
expr <- Block (Analysis a) -> [Expression (Analysis a)]
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 = Block (Analysis a) -> [Expression (Analysis a)]
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
(Int
expBlock, Int
expBBlock, ProgramUnitName
_) = ExpressionContext
exprCxt
bblock :: BB (Analysis a)
bblock = MemoryBlockName -> Maybe (BB (Analysis a)) -> BB (Analysis a)
forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
"Basic Block" (Maybe (BB (Analysis a)) -> BB (Analysis a))
-> Maybe (BB (Analysis a)) -> BB (Analysis a)
forall a b. (a -> b) -> a -> b
$ Gr (BB (Analysis a)) () -> Int -> Maybe (BB (Analysis a))
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab (BBGr (Analysis a) -> Gr (BB (Analysis a)) ()
forall a. BBGr a -> Gr (BB a) ()
bbgrGr BBGr (Analysis a)
gr) Int
expBBlock
precedingBlocks :: BB (Analysis a)
precedingBlocks = (Block (Analysis a) -> Bool) -> BB (Analysis a) -> BB (Analysis a)
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Block (Analysis a)
b -> Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Block (Analysis a) -> Maybe Int
forall a (b :: * -> *).
(Data a, Data (b (Analysis a)), Annotated b) =>
b (Analysis a) -> Maybe Int
label Block (Analysis a)
b) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
expBlock) BB (Analysis a)
bblock
inBBMemoryTables :: MemoryTables
inBBMemoryTables = InOut MemoryTables -> MemoryTables
forall a b. (a, b) -> a
fst (InOut MemoryTables -> MemoryTables)
-> (Maybe (InOut MemoryTables) -> InOut MemoryTables)
-> Maybe (InOut MemoryTables)
-> MemoryTables
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoryBlockName -> Maybe (InOut MemoryTables) -> InOut MemoryTables
forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
"Cannot find MemoryTables" (Maybe (InOut MemoryTables) -> MemoryTables)
-> Maybe (InOut MemoryTables) -> MemoryTables
forall a b. (a -> b) -> a -> b
$ Int -> InOutMap MemoryTables -> Maybe (InOut MemoryTables)
forall a. Int -> IntMap a -> Maybe a
IM.lookup
Int
expBBlock
InOutMap MemoryTables
memTables
inBlockMemoryTables :: MemoryTables
inBlockMemoryTables =
(MemoryTables -> Block (Analysis a) -> MemoryTables)
-> MemoryTables -> BB (Analysis a) -> MemoryTables
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (ProgramUnitModel
-> MemoryTables -> Block (Analysis a) -> MemoryTables
forall a.
ProgramUnitModel
-> MemoryTables -> Block (Analysis a) -> MemoryTables
varDefine ProgramUnitModel
puModel) MemoryTables
inBBMemoryTables BB (Analysis a)
precedingBlocks
in
SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
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@(Int
_, Int
_, ProgramUnitName
unitName) = Expression (Analysis a)
-> ExpressionContextMap -> ExpressionContext
forall a.
Data a =>
Expression a -> ExpressionContextMap -> ExpressionContext
lookupExpressionContext Expression (Analysis a)
expr ExpressionContextMap
exprCtxMap
puModel :: ProgramUnitModel
puModel = MemoryBlockName -> Maybe ProgramUnitModel -> ProgramUnitModel
forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
"Find SymbolTable" (Maybe ProgramUnitModel -> ProgramUnitModel)
-> Maybe ProgramUnitModel -> ProgramUnitModel
forall a b. (a -> b) -> a -> b
$ ProgramUnitName -> ProgramFileModel -> Maybe ProgramUnitModel
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ProgramUnitName
unitName ProgramFileModel
pfModel
controlFlowGraph :: BBGr (Analysis a)
controlFlowGraph =
MemoryBlockName -> Maybe (BBGr (Analysis a)) -> BBGr (Analysis a)
forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
"Find basic block graph" (Maybe (BBGr (Analysis a)) -> BBGr (Analysis a))
-> Maybe (BBGr (Analysis a)) -> BBGr (Analysis a)
forall a b. (a -> b) -> a -> b
$ ProgramUnitName
-> BBlockMap (Analysis a) -> Maybe (BBGr (Analysis a))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ProgramUnitName
unitName BBlockMap (Analysis a)
bbgraphs
memTables :: InOutMap MemoryTables
memTables = MemoryBlockName
-> Maybe (InOutMap MemoryTables) -> InOutMap MemoryTables
forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
"Find MemTables" (Maybe (InOutMap MemoryTables) -> InOutMap MemoryTables)
-> Maybe (InOutMap MemoryTables) -> InOutMap MemoryTables
forall a b. (a -> b) -> a -> b
$ ProgramUnitName -> MemoryTablesMap -> Maybe (InOutMap MemoryTables)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ProgramUnitName
unitName MemoryTablesMap
memTablesMap
in ProgramUnitModel
-> BBGr (Analysis a)
-> InOutMap MemoryTables
-> ExpressionContext
-> Expression (Analysis a)
-> CPValue
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 = ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseBBlocks ProgramFile (Analysis a)
pf
pfModel :: ProgramFileModel
pfModel = ProgramFile (Analysis a) -> ProgramFileModel
forall a. Data a => ProgramFile (Analysis a) -> ProgramFileModel
programFileModel ProgramFile (Analysis a)
pfb
bbgraphs :: BBlockMap (Analysis a)
bbgraphs = ProgramFile (Analysis a) -> BBlockMap (Analysis a)
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 =
MemoryBlockName -> Maybe ProgramUnitModel -> ProgramUnitModel
forall a. MemoryBlockName -> Maybe a -> a
fromJustMsg MemoryBlockName
"Find ProgramUnitModel" (Maybe ProgramUnitModel -> ProgramUnitModel)
-> Maybe ProgramUnitModel -> ProgramUnitModel
forall a b. (a -> b) -> a -> b
$ ProgramUnitName -> ProgramFileModel -> Maybe ProgramUnitModel
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ProgramUnitName
puName ProgramFileModel
pfModel
in ProgramUnitModel -> BBGr (Analysis a) -> InOutMap MemoryTables
forall a.
ProgramUnitModel -> BBGr (Analysis a) -> InOutMap MemoryTables
constantPropagationAnalysis ProgramUnitModel
puModel BBGr (Analysis a)
controlFlowGraph
memTablesMap :: MemoryTablesMap
memTablesMap = (ProgramUnitName -> BBGr (Analysis a) -> InOutMap MemoryTables)
-> BBlockMap (Analysis a) -> MemoryTablesMap
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey ProgramUnitName -> BBGr (Analysis a) -> InOutMap MemoryTables
forall {a}.
ProgramUnitName -> BBGr (Analysis a) -> InOutMap MemoryTables
mapFunc BBlockMap (Analysis a)
bbgraphs
exprCtxMap :: ExpressionContextMap
exprCtxMap = BBlockMap (Analysis a) -> ExpressionContextMap
forall a. Data a => BBlockMap (Analysis a) -> ExpressionContextMap
genExpressionContextMap BBlockMap (Analysis a)
bbgraphs
in ProgramFileModel
-> BBlockMap (Analysis a)
-> MemoryTablesMap
-> ExpressionContextMap
-> Expression (Analysis a)
-> CPValue
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
_ = MemoryBlockName -> 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 Int
label = Analysis a -> Maybe Int
forall a. Analysis a -> Maybe Int
insLabel (Analysis a -> Maybe Int)
-> (b (Analysis a) -> Analysis a) -> b (Analysis a) -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation
sizeOfArray :: Int -> [(Int, Int)] -> Int
sizeOfArray :: Int -> Dimensions -> Int
sizeOfArray Int
kind Dimensions
dimension =
let arraySize :: Int
arraySize = (Int -> Range -> Int) -> Int -> Dimensions -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
acc (Int
l, Int
h) -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Int
1 Dimensions
dimension
in Int
kind Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arraySize