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 :: ProgramUnitModel -> Statement (Analysis a) -> ProgramUnitModel
storageClassStmt ProgramUnitModel
puModel (StAutomatic Analysis a
_ SrcSpan
_ AList Declarator (Analysis a)
decls) = (ProgramUnitModel -> Declarator (Analysis a) -> ProgramUnitModel)
-> ProgramUnitModel
-> [Declarator (Analysis a)]
-> ProgramUnitModel
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ProgramUnitModel -> Declarator (Analysis a) -> ProgramUnitModel
forall a.
ProgramUnitModel -> Declarator (Analysis a) -> ProgramUnitModel
f
                                                          ProgramUnitModel
puModel
                                                          (AList Declarator (Analysis a) -> [Declarator (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Declarator (Analysis a)
decls)
 where
  f :: ProgramUnitModel -> Declarator (Analysis a) -> ProgramUnitModel
f ProgramUnitModel
m (DeclVariable Analysis a
_ SrcSpan
_ Expression (Analysis a)
varExp Maybe (Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_) =
    Name -> StorageClass -> ProgramUnitModel -> ProgramUnitModel
updateStorageClass (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
srcName Expression (Analysis a)
varExp) StorageClass
Automatic ProgramUnitModel
m
  f ProgramUnitModel
m (DeclArray Analysis a
_ SrcSpan
_ Expression (Analysis a)
varExp AList DimensionDeclarator (Analysis a)
_ Maybe (Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_) =
    Name -> StorageClass -> ProgramUnitModel -> ProgramUnitModel
updateStorageClass (Expression (Analysis a) -> Name
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)) = (ProgramUnitModel -> Expression (Analysis a) -> ProgramUnitModel)
-> ProgramUnitModel
-> [Expression (Analysis a)]
-> ProgramUnitModel
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ProgramUnitModel -> Expression (Analysis a) -> ProgramUnitModel
forall a.
ProgramUnitModel -> Expression (Analysis a) -> ProgramUnitModel
f
                                                           ProgramUnitModel
puModel
                                                           (AList Expression (Analysis a) -> [Expression (Analysis a)]
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 (Expression (Analysis a) -> Name
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 Name -> SymbolTable -> Maybe SymbolTableEntry
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 Name -> StorageTable -> Maybe MemoryBlock
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 StorageClass -> StorageClass -> Bool
forall a. Eq a => a -> a -> Bool
/= StorageClass
stClass ->
          let blk :: MemoryBlock
blk = MemoryBlock
block { storageClass :: StorageClass
storageClass = StorageClass
stClass }
          in  (SymbolTable
symTable, Name -> MemoryBlock -> StorageTable -> StorageTable
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

-- | Given all of the 'Statement's in a program as well as a 'ProgramUnitModel', produce a new
-- 'ProgramUnitModel' where the 'StorageClass's of each symbol have been determined
processStorageClass
  :: Data a => [Statement (Analysis a)] -> ProgramUnitModel -> ProgramUnitModel
processStorageClass :: [Statement (Analysis a)] -> ProgramUnitModel -> ProgramUnitModel
processStorageClass [Statement (Analysis a)]
stmts ProgramUnitModel
puModel0 = (ProgramUnitModel -> Statement (Analysis a) -> ProgramUnitModel)
-> ProgramUnitModel -> [Statement (Analysis a)] -> ProgramUnitModel
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ProgramUnitModel -> Statement (Analysis a) -> ProgramUnitModel
forall a.
Data a =>
ProgramUnitModel -> Statement (Analysis a) -> ProgramUnitModel
storageClassStmt ProgramUnitModel
puModel0 [Statement (Analysis a)]
stmts