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

-- | 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 :: 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