module Language.Fortran.Vars.StorageClass
( processStorageClass
)
where
import Data.Data ( Data )
import Data.List ( foldl' )
import qualified Data.Map as M
import Language.Fortran.Analysis ( Analysis
, srcName
)
import Language.Fortran.AST ( aStrip
, Declarator(..)
, Expression(..)
, Name
, Statement(..)
, Value(..)
)
import Language.Fortran.Vars.Types
( SymbolTableEntry(..)
, MemoryBlock(..)
, ProgramUnitModel
, StorageClass(..)
)
storageClassStmt
:: Data a => ProgramUnitModel -> Statement (Analysis a) -> ProgramUnitModel
storageClassStmt :: forall a.
Data a =>
ProgramUnitModel -> Statement (Analysis a) -> ProgramUnitModel
storageClassStmt ProgramUnitModel
puModel (StAutomatic Analysis a
_ SrcSpan
_ AList Declarator (Analysis a)
decls) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}.
ProgramUnitModel -> Declarator (Analysis a) -> ProgramUnitModel
f
ProgramUnitModel
puModel
(forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Declarator (Analysis a)
decls)
where
f :: ProgramUnitModel -> Declarator (Analysis a) -> ProgramUnitModel
f ProgramUnitModel
m (Declarator Analysis a
_ SrcSpan
_ Expression (Analysis a)
varExp DeclaratorType (Analysis a)
_ Maybe (Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_) =
Name -> StorageClass -> ProgramUnitModel -> ProgramUnitModel
updateStorageClass (forall a. Expression (Analysis a) -> Name
srcName Expression (Analysis a)
varExp) StorageClass
Automatic ProgramUnitModel
m
storageClassStmt ProgramUnitModel
puModel (StSave Analysis a
_ SrcSpan
_ (Just AList Expression (Analysis a)
exps)) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}.
ProgramUnitModel -> Expression (Analysis a) -> ProgramUnitModel
f
ProgramUnitModel
puModel
(forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Expression (Analysis a)
exps)
where
f :: ProgramUnitModel -> Expression (Analysis a) -> ProgramUnitModel
f ProgramUnitModel
m e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ (ValVariable Name
_)) =
Name -> StorageClass -> ProgramUnitModel -> ProgramUnitModel
updateStorageClass (forall a. Expression (Analysis a) -> Name
srcName Expression (Analysis a)
e) StorageClass
Static ProgramUnitModel
m
f ProgramUnitModel
m Expression (Analysis a)
_ = ProgramUnitModel
m
storageClassStmt ProgramUnitModel
puModel Statement (Analysis a)
_ = ProgramUnitModel
puModel
updateStorageClass
:: Name -> StorageClass -> ProgramUnitModel -> ProgramUnitModel
updateStorageClass :: Name -> StorageClass -> ProgramUnitModel -> ProgramUnitModel
updateStorageClass Name
symbol StorageClass
stClass m :: ProgramUnitModel
m@(SymbolTable
symTable, StorageTable
storageTable) =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
symbol SymbolTable
symTable of
Just (SVariable Type
_ (Name
blockName, Offset
_)) ->
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
blockName StorageTable
storageTable of
Just MemoryBlock
block | MemoryBlock -> StorageClass
storageClass MemoryBlock
block forall a. Eq a => a -> a -> Bool
/= StorageClass
stClass ->
let blk :: MemoryBlock
blk = MemoryBlock
block { storageClass :: StorageClass
storageClass = StorageClass
stClass }
in (SymbolTable
symTable, forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
blockName MemoryBlock
blk StorageTable
storageTable)
Maybe MemoryBlock
_ -> ProgramUnitModel
m
Maybe SymbolTableEntry
_ -> ProgramUnitModel
m
processStorageClass
:: Data a => [Statement (Analysis a)] -> ProgramUnitModel -> ProgramUnitModel
processStorageClass :: forall a.
Data a =>
[Statement (Analysis a)] -> ProgramUnitModel -> ProgramUnitModel
processStorageClass [Statement (Analysis a)]
stmts ProgramUnitModel
puModel0 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a.
Data a =>
ProgramUnitModel -> Statement (Analysis a) -> ProgramUnitModel
storageClassStmt ProgramUnitModel
puModel0 [Statement (Analysis a)]
stmts