{-# 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
                                                )

-- | ValueOf is a closure that takes an 'Expression' and deduces its 'CPValue'
type ValueOf a = Expression (Analysis a) -> CPValue

-- | MemoryTable represents the determined memory state of a particular memory
-- block. It contains the mappings between a piece of memory and its 'CPValue'.
-- The piece of memory is represented by an inclusive range inside a 'MemoryBlock'
type MemoryTable = M.Map Range CPValue

-- | MemoryTables contains 'MemoryTable's for all 'MemoryBlock's
type MemoryTables = M.Map MemoryBlockName MemoryTable

-- | Collection of output of constant propagation analysis ('InOutMap' 'MemoryTables')
-- for each ProgramUnit
type MemoryTablesMap = M.Map ProgramUnitName (InOutMap MemoryTables)

-- | Given a 'SymbolTable', 'MemoryTables', a possible specification of the
-- beginning of the substring as well as one for the end, and the length of
-- the original string, generate the bounds that should be used for the
-- substring. If the bounds cannot be determined the extraction will return
-- 'Nothing'.
extractSubstringBounds
  :: SymbolTable
  -> MemoryTables
  -> Maybe (Expression (Analysis a))
  -> Maybe (Expression (Analysis a))
  -> Int
  -> Maybe (Int, Int)
extractSubstringBounds :: SymbolTable
-> MemoryTables
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Int
-> Maybe (Int, Int)
extractSubstringBounds 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) -> (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
b, Int
e)
        (Maybe Int, Maybe Int)
_                -> Maybe (Int, Int)
forall a. Maybe a
Nothing

-- | Given a 'SymbolTable', 'MemoryTables', the base 'Expression' of the substring,
-- any 'Index's that accompany the base, and possible the specifications for
-- the beginning and end of the substring, return the 'CPValue' of the substring.
substringCPValue
  :: SymbolTable
  -> MemoryTables
  -> Expression (Analysis a)
  -> [Index (Analysis a)]
  -> Maybe (Expression (Analysis a))
  -> Maybe (Expression (Analysis a))
  -> CPValue
substringCPValue :: 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 :: [Char]
errStr         = [Char]
"Array sections are not allowed in FORTRAN 77"
      name :: [Char]
name           = Expression (Analysis a) -> [Char]
forall a. Expression (Analysis a) -> [Char]
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
$ [Char] -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Char]
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 [Char] -> CPValue
forall a. HasCallStack => [Char] -> a
error [Char]
errStr
        else case SymbolTable
-> MemoryTables -> [Char] -> [Index (Analysis a)] -> CPValue
forall a.
SymbolTable
-> MemoryTables -> [Char] -> [Index (Analysis a)] -> CPValue
lookupArray SymbolTable
symTable MemoryTables
memTables [Char]
name [Index (Analysis a)]
is of
          CPValue
Top -> CPValue
Top
          CPValue
Bot -> CPValue
Bot
          Const (Str [Char]
s) ->
            case SymbolTable
-> MemoryTables
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Int
-> Maybe (Int, Int)
forall a.
SymbolTable
-> MemoryTables
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Int
-> Maybe (Int, Int)
extractSubstringBounds SymbolTable
symTable MemoryTables
memTables Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me (Int -> Maybe (Int, Int)) -> Int -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s of
              Just (Int
b', Int
e') ->
                ExpVal -> CPValue
Const (ExpVal -> CPValue) -> ([Char] -> ExpVal) -> [Char] -> CPValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ExpVal
Str ([Char] -> CPValue) -> [Char] -> CPValue
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
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) ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop (Int
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Char]
s
              Maybe (Int, Int)
Nothing -> CPValue
Bot
          CPValue
_ -> [Char] -> CPValue
forall a. HasCallStack => [Char] -> a
error [Char]
errStr

-- | Given 'SymbolTable', 'MemoryTables' and an 'Expression', determine the 'CPValue'
-- of the 'Expression'
cpValue :: SymbolTable -> MemoryTables -> Expression (Analysis a) -> CPValue
cpValue :: 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 -> [Char] -> CPValue
lookupName SymbolTable
symTable MemoryTables
memTables ([Char] -> CPValue) -> [Char] -> CPValue
forall a b. (a -> b) -> a -> b
$ Expression (Analysis a) -> [Char]
forall a. Expression (Analysis a) -> [Char]
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 -> [Char] -> [Index (Analysis a)] -> CPValue
forall a.
SymbolTable
-> MemoryTables -> [Char] -> [Index (Analysis a)] -> CPValue
lookupArray SymbolTable
symTable MemoryTables
memTables (Expression (Analysis a) -> [Char]
forall a. Expression (Analysis a) -> [Char]
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)
_ -> [Char] -> CPValue
forall a. HasCallStack => [Char] -> a
error ([Char] -> CPValue) -> [Char] -> CPValue
forall a b. (a -> b) -> a -> b
$ [Char]
"Evaluation of the expression is not implemented - " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SrcSpan -> [Char]
forall a. Show a => a -> [Char]
show
    (Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
expr)

-- | A piece of memory is represented as inclusive range indicating the start and
-- end offset of the memory within a memory block. This function is used for scalar
-- variable.
getVariableMemory :: SymbolTable -> Name -> Maybe (MemoryBlockName, Range)
getVariableMemory :: SymbolTable -> [Char] -> Maybe ([Char], (Int, Int))
getVariableMemory SymbolTable
symTable [Char]
name = case [Char] -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Char]
name SymbolTable
symTable of
  -- Array pointer passed to subroutine/function (thus treated as 'ValVariable')
  Just (SVariable (TArray SemType
ty Maybe Dimensions
dims) ([Char]
memBlockName, Int
offset)) -> do
    Int
kind  <- SemType -> Maybe Int
getTypeKind SemType
ty
    Dimensions
dims' <- Maybe Dimensions
dims
    ([Char], (Int, Int)) -> Maybe ([Char], (Int, Int))
forall a. a -> Maybe a
Just ([Char]
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 ([Char]
memBlockName, Int
offset)) -> do
    Int
kind <- SemType -> Maybe Int
getTypeKind SemType
ty
    ([Char], (Int, Int)) -> Maybe ([Char], (Int, Int))
forall a. a -> Maybe a
Just ([Char]
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 ([Char], (Int, Int))
forall a. Maybe a
Nothing
  Just SDummy{}     -> Maybe ([Char], (Int, Int))
forall a. Maybe a
Nothing
  Maybe SymbolTableEntry
Nothing           -> Maybe ([Char], (Int, Int))
forall a. Maybe a
Nothing
  Maybe SymbolTableEntry
_                 -> [Char] -> Maybe ([Char], (Int, Int))
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe ([Char], (Int, Int)))
-> [Char] -> Maybe ([Char], (Int, Int))
forall a b. (a -> b) -> a -> b
$ [Char]
"getVariableMemory -  not a variable : " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name

-- | Given a 'CPValue' without any present 'Bot' or 'Top'
-- 'CPValue's, convert to an 'Int'
unsafeStripIndexCP :: CPValue -> Int
unsafeStripIndexCP :: CPValue -> Int
unsafeStripIndexCP (Const (Int Int
i)) = Int
i
unsafeStripIndexCP CPValue
_ = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Expected no Top, Bot, nor non Int values"

-- | This data type describes the memory layout of an array's memory with
-- some additional qualification.
--
-- If any of the indices is unknown then the range of the array expression is
-- unknown. In this case 'UnknownIndices' variant is used with the range set
-- as the whole range of the array.
--
-- On the other hand, if indices are known constant, then the exact
-- range for the indices is used with the 'ConstantIndices' variant.
--
-- If the variable is a string declared as a scalar, the 'UnknownIndices' variant is
-- used with the range set to the size of the variable.
data ArrayMemory
  = UnknownIndices (MemoryBlockName, Range)
  | ConstantIndices (MemoryBlockName, Range)

-- | This function is used for array variable. It returns the range of the
-- specified element.
getArrayMemory
  :: SymbolTable
  -> MemoryTables
  -> Name
  -> [Index (Analysis a)]
  -> Maybe ArrayMemory
getArrayMemory :: SymbolTable
-> MemoryTables
-> [Char]
-> [Index (Analysis a)]
-> Maybe ArrayMemory
getArrayMemory SymbolTable
symTable MemoryTables
memTables [Char]
name [Index (Analysis a)]
indices =
  let Just SymbolTableEntry
entry  = [Char] -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Char]
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) ([Char]
memBlockName, Int
start)
          | (CPValue -> Bool) -> [CPValue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CPValue -> Bool
isBot [CPValue]
idxCPValues
          -> ([Char], (Int, Int)) -> ArrayMemory
UnknownIndices (([Char], (Int, Int)) -> ArrayMemory)
-> ((Int, Int) -> ([Char], (Int, Int)))
-> (Int, Int)
-> ArrayMemory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
memBlockName, ) ((Int, Int) -> ArrayMemory)
-> Maybe (Int, Int) -> Maybe ArrayMemory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Int, Int)
arrayRange
          | (CPValue -> Bool) -> [CPValue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CPValue -> Bool
isTop [CPValue]
idxCPValues
          -> ([Char], (Int, Int)) -> ArrayMemory
UnknownIndices (([Char], (Int, Int)) -> ArrayMemory)
-> ((Int, Int) -> ([Char], (Int, Int)))
-> (Int, Int)
-> ArrayMemory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
memBlockName, ) ((Int, Int) -> ArrayMemory)
-> Maybe (Int, Int) -> Maybe ArrayMemory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Int, Int)
arrayRange
          | Bool -> Bool
not ((CPValue -> Bool) -> [CPValue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CPValue -> Bool
isConstInt [CPValue]
idxCPValues)
          -> ([Char], (Int, Int)) -> ArrayMemory
UnknownIndices (([Char], (Int, Int)) -> ArrayMemory)
-> ((Int, Int) -> ([Char], (Int, Int)))
-> (Int, Int)
-> ArrayMemory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
memBlockName, ) ((Int, Int) -> ArrayMemory)
-> Maybe (Int, Int) -> Maybe ArrayMemory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Int, Int)
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
            (Int, Int)
range <- [Int] -> Int -> Dimensions -> Int -> (Int, Int)
generateLinearizedIndexRange [Int]
is Int
start (Dimensions -> Int -> (Int, Int))
-> Maybe Dimensions -> Maybe (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Dimensions
dims Maybe (Int -> (Int, Int)) -> Maybe Int -> Maybe (Int, Int)
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
$ ([Char], (Int, Int)) -> ArrayMemory
ConstantIndices ([Char]
memBlockName, (Int, Int)
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 (Int, Int)
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 -> (Int, Int)) -> Maybe Int -> Maybe (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
size
        SVariable SemType
ty ([Char]
memBlockName, Int
start)
          | [Index (Analysis a)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Index (Analysis a)]
indices -> ([Char], (Int, Int)) -> ArrayMemory
ConstantIndices (([Char], (Int, Int)) -> ArrayMemory)
-> ((Int, Int) -> ([Char], (Int, Int)))
-> (Int, Int)
-> ArrayMemory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
memBlockName, ) ((Int, Int) -> ArrayMemory)
-> Maybe (Int, Int) -> Maybe ArrayMemory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Int, Int)
range
          | Bool
otherwise    -> ([Char], (Int, Int)) -> ArrayMemory
UnknownIndices (([Char], (Int, Int)) -> ArrayMemory)
-> ((Int, Int) -> ([Char], (Int, Int)))
-> (Int, Int)
-> ArrayMemory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
memBlockName, ) ((Int, Int) -> ArrayMemory)
-> Maybe (Int, Int) -> Maybe ArrayMemory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Int, Int)
range
         where
          kind :: Maybe Int
kind  = SemType -> Maybe Int
getTypeKind SemType
ty
          range :: Maybe (Int, Int)
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 -> (Int, Int)) -> Maybe Int -> Maybe (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
kind
        SymbolTableEntry
_ -> Maybe ArrayMemory
forall a. Maybe a
Nothing

-- | Internal function to find 'CPValue' of a symbol
lookupName :: SymbolTable -> MemoryTables -> Name -> CPValue
lookupName :: SymbolTable -> MemoryTables -> [Char] -> CPValue
lookupName SymbolTable
symTable MemoryTables
memTables [Char]
name = case [Char] -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Char]
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

-- | Internal function to find 'CPValue' of a scalar variable
lookupScalarVariable :: MemoryTables -> Type -> Location -> CPValue
lookupScalarVariable :: MemoryTables -> SemType -> Location -> CPValue
lookupScalarVariable MemoryTables
memTables SemType
ty Location
loc =
  let ([Char]
memBlockName, Int
start) = Location
loc
      mkind :: Maybe Int
mkind                 = SemType -> Maybe Int
getTypeKind SemType
ty
      mrange :: Maybe (Int, Int)
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 -> (Int, Int)) -> Maybe Int -> Maybe (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mkind
  in  case Maybe (Int, Int)
mrange of
        Just (Int, Int)
range -> case [Char] -> MemoryTables -> Maybe MemoryTable
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Char]
memBlockName MemoryTables
memTables of
          Just MemoryTable
memTbl -> (Int, Int) -> MemoryTable -> CPValue
lookupRange (Int, Int)
range MemoryTable
memTbl
          Maybe MemoryTable
Nothing     -> CPValue
Top
        Maybe (Int, Int)
Nothing -> CPValue
Bot

-- | Internal fucntion to find 'CPValue' of an array element
lookupArray
  :: SymbolTable -> MemoryTables -> Name -> [Index (Analysis a)] -> CPValue
lookupArray :: SymbolTable
-> MemoryTables -> [Char] -> [Index (Analysis a)] -> CPValue
lookupArray SymbolTable
symTable MemoryTables
memTables [Char]
name [Index (Analysis a)]
indices =
  case SymbolTable
-> MemoryTables
-> [Char]
-> [Index (Analysis a)]
-> Maybe ArrayMemory
forall a.
SymbolTable
-> MemoryTables
-> [Char]
-> [Index (Analysis a)]
-> Maybe ArrayMemory
getArrayMemory SymbolTable
symTable MemoryTables
memTables [Char]
name [Index (Analysis a)]
indices of
    Maybe ArrayMemory
Nothing                 -> CPValue
Bot
    Just (UnknownIndices ([Char], (Int, Int))
_) -> CPValue
Bot
    Just (ConstantIndices ([Char]
memBlockName, (Int, Int)
range)) ->
      case [Char] -> MemoryTables -> Maybe MemoryTable
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Char]
memBlockName MemoryTables
memTables of
        Just MemoryTable
memTbl -> (Int, Int) -> MemoryTable -> CPValue
lookupRange (Int, Int)
range MemoryTable
memTbl
        Maybe MemoryTable
Nothing     -> CPValue
Top

-- | Internal function to resovle the 'CPValue's of array indices
cpValueOfIndices
  :: SymbolTable -> MemoryTables -> [Index (Analysis a)] -> [CPValue]
cpValueOfIndices :: 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 :: Index (Analysis a) -> CPValue
cpValueOfIndex (IxSingle Analysis a
_ SrcSpan
_ Maybe [Char]
_ 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)
_ = [Char] -> CPValue
forall a. HasCallStack => [Char] -> a
error [Char]
"Array sections are not allowed in FORTRAN 77"


-- | Internal function to look up the 'CPValue' of a 'Range'
lookupRange :: Range -> MemoryTable -> CPValue
lookupRange :: (Int, Int) -> MemoryTable -> CPValue
lookupRange (Int, Int)
range MemoryTable
memTable = case (Int, Int) -> MemoryTable -> Maybe CPValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Int, Int)
range MemoryTable
memTable of
  Just CPValue
val -> CPValue
val
  Maybe CPValue
Nothing | (Int, Int) -> Dimensions -> Bool
anyOverlap (Int, Int)
range (MemoryTable -> Dimensions
forall k a. Map k a -> [k]
M.keys MemoryTable
memTable) -> CPValue
Bot
  Maybe CPValue
_        -> CPValue
Top


-- | Constant Propagation Analysis
-- Given a 'ProgramUnitModel' and a control flow graph (basic blocks graph) of a
-- 'ProgramUnit', returns the In and Out 'MemoryTables' for each node in the graph
constantPropagationAnalysis
  :: ProgramUnitModel -> BBGr (Analysis a) -> InOutMap MemoryTables
constantPropagationAnalysis :: 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)
                      ([Char] -> Maybe (BB (Analysis a)) -> BB (Analysis a)
forall a. [Char] -> Maybe a -> a
fromJustMsg [Char]
"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)

-- | Given 'MemoryTables', a 'MemoryBlockName', and a 'Range',
-- update that 'Range' to contain the specified 'CPValue'. If
-- the boolean argument is set to true, delete any values in
-- overlapping ranges
updateRangeValue
  :: MemoryTables -> MemoryBlockName -> Range -> CPValue -> Bool -> MemoryTables
updateRangeValue :: MemoryTables
-> [Char] -> (Int, Int) -> CPValue -> Bool -> MemoryTables
updateRangeValue MemoryTables
memTables' [Char]
memBlockName (Int, Int)
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
$ [Char] -> MemoryTables -> Maybe MemoryTable
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Char]
memBlockName MemoryTables
memTables'
      rangeMap' :: MemoryTable
rangeMap' = if Bool
filt
        then ((Int, Int) -> CPValue -> Bool) -> MemoryTable -> MemoryTable
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\(Int, Int)
k CPValue
_ -> Bool -> Bool
not ((Int, Int) -> (Int, Int) -> Bool
overlap (Int, Int)
k (Int, Int)
range)) MemoryTable
rangeMap
        else MemoryTable
rangeMap
      newRangeMap :: MemoryTable
newRangeMap = (Int, Int) -> CPValue -> MemoryTable -> MemoryTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Int, Int)
range CPValue
val MemoryTable
rangeMap'
  in  [Char] -> MemoryTable -> MemoryTables -> MemoryTables
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert [Char]
memBlockName MemoryTable
newRangeMap MemoryTables
memTables'

-- | Process the definition of a substring in a block and update
-- the substring's 'CPValue' in the corresponding 'MemoryTable'.
--
-- Aside from the 'SymbolTable' and 'MemoryTable', this
-- function requires the base 'Expression' of the substring
-- as well as any 'Index's that go along with that base,
-- possibly a specification of the beginning and end of the
-- array, and finally the 'Expression' that is being assigned.
substringDefine
  :: SymbolTable
  -> MemoryTables
  -> Expression (Analysis a)
  -> [Index (Analysis a)]
  -> Maybe (Expression (Analysis a))
  -> Maybe (Expression (Analysis a))
  -> Expression (Analysis a)
  -> MemoryTables
substringDefine :: 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
-> [Char]
-> [Index (Analysis a)]
-> Maybe ArrayMemory
forall a.
SymbolTable
-> MemoryTables
-> [Char]
-> [Index (Analysis a)]
-> Maybe ArrayMemory
getArrayMemory SymbolTable
symTable MemoryTables
memTables (Expression (Analysis a) -> [Char]
forall a. Expression (Analysis a) -> [Char]
srcName Expression (Analysis a)
e) [Index (Analysis a)]
is of
    Maybe ArrayMemory
Nothing -> MemoryTables
memTables
    Just (UnknownIndices ([Char]
memBlockName, (Int, Int)
wholeArrayRange)) ->
      let val :: CPValue
val = CPValue
Bot
      in  MemoryTables
-> [Char] -> (Int, Int) -> CPValue -> Bool -> MemoryTables
updateRangeValue MemoryTables
memTables [Char]
memBlockName (Int, Int)
wholeArrayRange CPValue
val Bool
True
    Just (ConstantIndices ([Char]
memBlockName, (Int, Int)
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 [Char] -> MemoryTables -> Maybe MemoryTable
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Char]
memBlockName MemoryTables
memTables of
            Just MemoryTable
memTbl -> (Int, Int) -> MemoryTable -> CPValue
lookupRange (Int, Int)
range MemoryTable
memTbl
            Maybe MemoryTable
Nothing     -> CPValue
Top
          val' :: CPValue
val' = case CPValue
val of
            Const (Str [Char]
s) -> case CPValue
str of
              Const (Str [Char]
o) ->
                case
                    SymbolTable
-> MemoryTables
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Int
-> Maybe (Int, Int)
forall a.
SymbolTable
-> MemoryTables
-> Maybe (Expression (Analysis a))
-> Maybe (Expression (Analysis a))
-> Int
-> Maybe (Int, Int)
extractSubstringBounds SymbolTable
symTable MemoryTables
memTables Maybe (Expression (Analysis a))
mb Maybe (Expression (Analysis a))
me (Int -> Maybe (Int, Int)) -> Int -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
o
                  of
                    Just (Int
b', Int
e') ->
                      let s' :: [Char]
s' = [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
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
- [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) Char
' '
                      in  ExpVal -> CPValue
Const (ExpVal -> CPValue) -> ([Char] -> ExpVal) -> [Char] -> CPValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ExpVal
Str ([Char] -> CPValue) -> [Char] -> CPValue
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Char]
o [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
e' [Char]
o
                    Maybe (Int, Int)
Nothing -> CPValue
Bot
              CPValue
_ -> CPValue
Bot
            CPValue
_ -> CPValue
Bot
      in  MemoryTables
-> [Char] -> (Int, Int) -> CPValue -> Bool -> MemoryTables
updateRangeValue MemoryTables
memTables [Char]
memBlockName (Int, Int)
range CPValue
val' Bool
True

-- | Process the definition of a variable in a block and update the
-- variable's 'CPValue' in the corresponding 'MemoryTable'.
varDefine
  :: ProgramUnitModel -> MemoryTables -> Block (Analysis a) -> MemoryTables
varDefine :: 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 :: [Char]
name = Expression (Analysis a) -> [Char]
forall a. Expression (Analysis a) -> [Char]
srcName Expression (Analysis a)
expr
    in
      case SymbolTable -> [Char] -> Maybe ([Char], (Int, Int))
getVariableMemory SymbolTable
symTable [Char]
name of
        Just ([Char]
memBlockName, range :: (Int, Int)
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
$ [Char] -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Char]
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 ([Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
"Couldn't get kind of type " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> SemType -> [Char]
forall a. Show a => a -> [Char]
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 [Char]
s) -> ExpVal -> CPValue
Const (ExpVal -> CPValue) -> (Char -> ExpVal) -> Char -> CPValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ExpVal
Str ([Char] -> ExpVal) -> (Char -> [Char]) -> Char -> ExpVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
kind (Char -> CPValue) -> Char -> CPValue
forall a b. (a -> b) -> a -> b
$ if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s
                      then Char
' '
                      else [Char] -> Char
forall a. [a] -> a
head [Char]
s
                    CPValue
_ -> CPValue
val
                  handler :: MemoryTables -> (Int, Int) -> MemoryTables
handler MemoryTables
mt (Int, Int)
range' =
                    MemoryTables
-> [Char] -> (Int, Int) -> CPValue -> Bool -> MemoryTables
updateRangeValue MemoryTables
mt [Char]
memBlockName (Int, Int)
range' CPValue
val' Bool
True
                in
                  (MemoryTables -> (Int, Int) -> MemoryTables)
-> MemoryTables -> Dimensions -> MemoryTables
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' MemoryTables -> (Int, Int) -> 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
-> [Char] -> (Int, Int) -> CPValue -> Bool -> MemoryTables
updateRangeValue MemoryTables
memTables [Char]
memBlockName (Int, Int)
range CPValue
val Bool
True
        Maybe ([Char], (Int, Int))
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
-> [Char]
-> [Index (Analysis a)]
-> Maybe ArrayMemory
forall a.
SymbolTable
-> MemoryTables
-> [Char]
-> [Index (Analysis a)]
-> Maybe ArrayMemory
getArrayMemory SymbolTable
symTable MemoryTables
memTables (Expression (Analysis a) -> [Char]
forall a. Expression (Analysis a) -> [Char]
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 ([Char]
memBlockName, (Int, Int)
wholeArrayRange)) ->
      let val :: CPValue
val = CPValue
Bot
      in  MemoryTables
-> [Char] -> (Int, Int) -> CPValue -> Bool -> MemoryTables
updateRangeValue MemoryTables
memTables [Char]
memBlockName (Int, Int)
wholeArrayRange CPValue
val Bool
True
    Just (ConstantIndices ([Char]
memBlockName, (Int, Int)
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
-> [Char] -> (Int, Int) -> CPValue -> Bool -> MemoryTables
updateRangeValue MemoryTables
memTables [Char]
memBlockName (Int, Int)
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 :: Expression (Analysis a) -> Bool
inCommon Expression (Analysis a)
e = case [Char] -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Expression (Analysis a) -> [Char]
forall a. Expression (Analysis a) -> [Char]
srcName Expression (Analysis a)
e) SymbolTable
symTable of
    Just (SVariable SemType
_ ([Char]
memBlockName, Int
_)) ->
      case [Char] -> StorageTable -> Maybe MemoryBlock
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Char]
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


-- | ExpressionContext represents the block, basic block and 'ProgramUnit'
-- in which an expression is located
type ExpressionContext = (Node, Node, ProgramUnitName)

-- | Mapping from expression source span to 'ExpressionContext'
type ExpressionContextMap = M.Map SrcSpan ExpressionContext


-- | Look up the 'ExpressionContext' of an 'Expression'
lookupExpressionContext
  :: Data a => Expression a -> ExpressionContextMap -> ExpressionContext
lookupExpressionContext :: 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 :: [Char]
err = [Char]
"Lookup Expression Context at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SrcSpan -> [Char]
forall a. Show a => a -> [Char]
show SrcSpan
s
  in  [Char] -> Maybe ExpressionContext -> ExpressionContext
forall a. [Char] -> Maybe a -> a
fromJustMsg [Char]
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

-- | Given 'BBlockMap', generates 'ExpressionContextMap'
genExpressionContextMap
  :: Data a => BBlockMap (Analysis a) -> ExpressionContextMap
genExpressionContextMap :: 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 :: Block (Analysis a) -> [Expression (Analysis a)]
allExp = Block (Analysis a) -> [Expression (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi


-- | Determine the 'CPValue' of an expression in a 'ProgramUnit' using constant
-- propagation analysis
--
-- Input:
--
--   * 'ProgramUnitModel'
--   * 'BBGr' -  Control Flow Graph of Basic Blocks
--   * 'InOutMap' 'MemoryTables' - generated by constantPropagationAnalysis
--   * 'ExpressionContextMap' - to identify the block and basic block of the input expression
--   * 'Expression'
--
-- Output:
--
--   * 'CPValue'
--
-- Description:
--
--   The control flow graph and the associated In and Out 'MemoryTables' are at the
--   level of Basic Block, which is coarse-grained with regard to Expression.
--   The memory state at the beginning of basic block may not represent
--   the memory state at the site of the expression. To get more precise determination
--   of value, the 'MemoryTables' is updated by processing each blocks preceding
--   the enclosing block of input expression.
--
--   The updated 'MemoryTables' is then used to determine the value of the 'Expression'.
constantPropagationValuePU
  :: Data a
  => ProgramUnitModel
  -> BBGr (Analysis a)
  -> InOutMap MemoryTables
  -> ExpressionContext
  -> Expression (Analysis a)
  -> CPValue
constantPropagationValuePU :: 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 = [Char] -> Maybe (BB (Analysis a)) -> BB (Analysis a)
forall a. [Char] -> Maybe a -> a
fromJustMsg [Char]
"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
. [Char] -> Maybe (InOut MemoryTables) -> InOut MemoryTables
forall a. [Char] -> Maybe a -> a
fromJustMsg [Char]
"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

-- | Internal function to determine the 'CPValue' of an expression in a 'ProgramFile'
-- using constantpropagation analysis
constantPropagationValuePF
  :: Data a
  => ProgramFileModel
  -> BBlockMap (Analysis a)
  -> MemoryTablesMap
  -> ExpressionContextMap
  -> Expression (Analysis a)
  -> CPValue
constantPropagationValuePF :: 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 = [Char] -> Maybe ProgramUnitModel -> ProgramUnitModel
forall a. [Char] -> Maybe a -> a
fromJustMsg [Char]
"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 =
          [Char] -> Maybe (BBGr (Analysis a)) -> BBGr (Analysis a)
forall a. [Char] -> Maybe a -> a
fromJustMsg [Char]
"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 = [Char] -> Maybe (InOutMap MemoryTables) -> InOutMap MemoryTables
forall a. [Char] -> Maybe a -> a
fromJustMsg [Char]
"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


-- | Given a 'ProgramFile', return 'ValueOf' closure, which determines
-- whether given 'Expression' can be evaluated statically to a constant value using
-- constant propagation analysis.
--
-- Usage:
--   The best approach is to create a closure first as illustrated in the following
--   code example, so only one run of constant propragation analysis is performed
--   for a 'ProgramFile'.
--
--   @
--   let cpValueOf = constantPropagationValue pf
--   ...
--   in
--       ...
--       cpVauleOf e1
--       cpValueOf e2
--   @
constantPropagationValue :: Data a => ProgramFile (Analysis a) -> ValueOf a
constantPropagationValue :: 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 =
                  [Char] -> Maybe ProgramUnitModel -> ProgramUnitModel
forall a. [Char] -> Maybe a -> a
fromJustMsg [Char]
"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
-> ValueOf a
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

-- Utility functions
fromJustMsg :: String -> Maybe a -> a
fromJustMsg :: [Char] -> Maybe a -> a
fromJustMsg [Char]
_   (Just a
x) = a
x
fromJustMsg [Char]
msg Maybe a
_        = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
msg

-- | 'Language.Fortran.Analysis.BBlocks.analyseBBlocks' annotates the 'Block'
-- and 'Expression' AST node with unique integer label. This function retrieves
-- the label from an AST node if the label exsits.
label
  :: forall a b
   . (Data a, Data (b (Analysis a)), Annotated b)
  => b (Analysis a)
  -> Maybe Int
label :: 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

-- | Given kind and dimensions, calculate the size of an array
sizeOfArray :: Int -> [(Int, Int)] -> Int
sizeOfArray :: Int -> Dimensions -> Int
sizeOfArray Int
kind Dimensions
dimension =
  let arraySize :: Int
arraySize = (Int -> (Int, Int) -> 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