module Language.Fortran.Vars.SymbolTable
  ( collectSymbols
  )
where

import           Data.Data                      ( Data
                                                , toConstr
                                                )
import           Data.List                      ( foldl' )
import qualified Data.Map                      as M
import           Language.Fortran.Analysis      ( Analysis
                                                , srcName
                                                )
import           Language.Fortran.AST           ( AList
                                                , Argument(..)
                                                , aStrip
                                                , BaseType(..)
                                                , Block(..)
                                                , CommonGroup(..)
                                                , Declarator(..)
                                                , DimensionDeclarator(..)
                                                , Expression(..)
                                                , Index(..)
                                                , Name
                                                , ProgramUnit(..)
                                                , programUnitBody
                                                , Statement(..)
                                                , Selector(..)
                                                , TypeSpec(..)
                                                , Value(..)
                                                )

import           Language.Fortran.Vars.Eval
                                                ( eval
                                                , eval'
                                                )
import           Language.Fortran.Vars.BozConstant
                                                ( resolveBozConstant )
import           Language.Fortran.Vars.Types
                                                ( ExpVal(..)
                                                , SymbolTableEntry(..)
                                                , Type(..)
                                                , SemType(..)
                                                , CharacterLen(..)
                                                , SymbolTable
                                                )
import           Language.Fortran.Vars.Utils
                                                ( typeSpecToScalarType
                                                , typeSpecToArrayType
                                                )
import           Language.Fortran.Vars.Kind
                                                ( getKind
                                                , getTypeKind
                                                , setTypeKind
                                                , getKindOfExpVal
                                                , toInt
                                                , typeOfExpVal
                                                , baseToType
                                                , isStr
                                                )

-- | Given a 'SymbolTable' and a 'DimensionDeclarator', return a pair of
-- resolved 'DynamicDimensionElement's representing lower- and upper- bound
resolveDimensionDimensionDeclarator
  :: SymbolTable -> DimensionDeclarator (Analysis a) -> Maybe (Int, Int)
resolveDimensionDimensionDeclarator :: SymbolTable -> DimensionDeclarator (Analysis a) -> Maybe (Int, Int)
resolveDimensionDimensionDeclarator SymbolTable
symTable (DimensionDeclarator Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
lowerbound Maybe (Expression (Analysis a))
upperbound)
  = do
    Int
lb <- Maybe (Expression (Analysis a)) -> Maybe Int
forall a. Maybe (Expression a) -> Maybe Int
valueOf Maybe (Expression (Analysis a))
lowerbound
    Int
ub <- Maybe (Expression (Analysis a)) -> Maybe Int
forall a. Maybe (Expression a) -> Maybe Int
valueOf Maybe (Expression (Analysis a))
upperbound
    (Int, Int) -> Maybe (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
lb, Int
ub)
 where
  valueOf :: Maybe (Expression a) -> Maybe Int
valueOf (Just (ExpValue a
_ SrcSpan
_ Value a
ValStar)) = Maybe Int
forall a. Maybe a
Nothing
  valueOf (Just (ExpValue a
_ SrcSpan
_ (ValVariable Name
name))) =
    case Name -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name SymbolTable
symTable of
      Just (SParameter Type
_ (Int Int
i)) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
      Maybe SymbolTableEntry
_                           -> Maybe Int
forall a. Maybe a
Nothing
  valueOf (Just Expression a
expr) = case SymbolTable -> Expression a -> Either Name ExpVal
forall a. SymbolTable -> Expression a -> Either Name ExpVal
eval' SymbolTable
symTable Expression a
expr of
    Right (Int Int
i) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
    Either Name ExpVal
_             -> Maybe Int
forall a. Maybe a
Nothing
  valueOf Maybe (Expression a)
Nothing = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1

-- | Given a 'SymbolTable' and an 'Index', return a pair of
-- resolved 'DynamicDimensionElement's representing lower- and upper- bound
resolveDimensionExpSubscript
  :: SymbolTable -> Index (Analysis a) -> Maybe (Int, Int)
resolveDimensionExpSubscript :: SymbolTable -> Index (Analysis a) -> Maybe (Int, Int)
resolveDimensionExpSubscript SymbolTable
symTable Index (Analysis a)
index = case Index (Analysis a)
index of
  IxSingle Analysis a
_ SrcSpan
_ Maybe Name
_ Expression (Analysis a)
upperbound -> do
    Int
ub <- Expression (Analysis a) -> Maybe Int
forall a. Expression a -> Maybe Int
valueOf Expression (Analysis a)
upperbound
    (Int, Int) -> Maybe (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, Int
ub)
  IxRange Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
lowerbound Maybe (Expression (Analysis a))
upperbound Maybe (Expression (Analysis a))
_ -> do
    Int
lb <- Maybe (Expression (Analysis a))
lowerbound Maybe (Expression (Analysis a))
-> (Expression (Analysis a) -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Expression (Analysis a) -> Maybe Int
forall a. Expression a -> Maybe Int
valueOf
    Int
ub <- Maybe (Expression (Analysis a))
upperbound Maybe (Expression (Analysis a))
-> (Expression (Analysis a) -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Expression (Analysis a) -> Maybe Int
forall a. Expression a -> Maybe Int
valueOf
    (Int, Int) -> Maybe (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
lb, Int
ub)
 where
  valueOf :: Expression a -> Maybe Int
valueOf Expression a
expr = case SymbolTable -> Expression a -> Either Name ExpVal
forall a. SymbolTable -> Expression a -> Either Name ExpVal
eval' SymbolTable
symTable Expression a
expr of
    Right (Int Int
i) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
    Either Name ExpVal
_             -> Maybe Int
forall a. Maybe a
Nothing

-- | Given a 'SymbolTable' and an 'Argument', return a maybe pair of Ints
-- representing lower- and upper- bound
resolveDimensionExpFunctionCall
  :: SymbolTable -> Argument (Analysis a) -> Maybe (Int, Int)
resolveDimensionExpFunctionCall :: SymbolTable -> Argument (Analysis a) -> Maybe (Int, Int)
resolveDimensionExpFunctionCall SymbolTable
symTable (Argument Analysis a
_ SrcSpan
_ Maybe Name
_ Expression (Analysis a)
upperbound) =
  let ub :: Int
ub = ExpVal -> Int
toInt (SymbolTable -> Expression (Analysis a) -> ExpVal
forall a. SymbolTable -> Expression a -> ExpVal
eval SymbolTable
symTable Expression (Analysis a)
upperbound) in (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
1, Int
ub)

-- Parameter declarations
-- A parameter may or may not have a type declaration. If it does have one,
-- the declaration statement can go before or after the parameter statement.
handleParameter
  :: Data a => SymbolTable -> AList Declarator (Analysis a) -> SymbolTable
handleParameter :: SymbolTable -> AList Declarator (Analysis a) -> SymbolTable
handleParameter SymbolTable
symTable AList Declarator (Analysis a)
alist = (SymbolTable -> Declarator (Analysis a) -> SymbolTable)
-> SymbolTable -> [Declarator (Analysis a)] -> SymbolTable
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SymbolTable -> Declarator (Analysis a) -> SymbolTable
forall a. SymbolTable -> Declarator (Analysis a) -> SymbolTable
f SymbolTable
symTable (AList Declarator (Analysis a) -> [Declarator (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Declarator (Analysis a)
alist)
 where
  f :: SymbolTable -> Declarator (Analysis a) -> SymbolTable
f SymbolTable
symt (DeclVariable Analysis a
_ SrcSpan
_ Expression (Analysis a)
varExp Maybe (Expression (Analysis a))
_ (Just Expression (Analysis a)
valExp)) =
    let symbol :: Name
symbol = Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
srcName Expression (Analysis a)
varExp
        val' :: ExpVal
val'   = case SymbolTable -> Expression (Analysis a) -> ExpVal
forall a. SymbolTable -> Expression a -> ExpVal
eval SymbolTable
symt Expression (Analysis a)
valExp of
          boz :: ExpVal
boz@(Boz Name
_) -> SymbolTable -> Name -> ExpVal -> ExpVal
resolveBozConstant SymbolTable
symTable Name
symbol ExpVal
boz
          ExpVal
v           -> ExpVal
v
        kind' :: Int
kind' = ExpVal -> Int
getKindOfExpVal ExpVal
val'   -- infer kind from value
        pd' :: SymbolTableEntry
pd'   = Type -> ExpVal -> SymbolTableEntry
SParameter (Type -> Maybe Int -> Type
setTypeKind (ExpVal -> Type
typeOfExpVal ExpVal
val') (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
kind')) ExpVal
val'
        entry :: SymbolTableEntry
entry = case Name -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
symbol SymbolTable
symt of
                 -- Entry found implies there is a preceding declaration
                 -- of the name. 
                 -- If that is variable declaration, keep the accurate type
                 -- and kind informatio from the declaration.
                 -- Else if it is dummy variable, keep the accurate type 
                 -- and update kind
                 -- Else raise error for conflicting parameter attribute
                 -- Parameter name does not necessarily have a type
                 -- declaration or a kind is assumed. In that case type
                 -- and kind are inferred from the value of parameter.
          Maybe SymbolTableEntry
Nothing               -> SymbolTableEntry
pd'
          Just (SVariable Type
ty Location
_) -> case Type
ty of
            -- TODO previously TCharacter Nothing
            TCharacter CharacterLen
CharLenStar Int
_ -> SymbolTableEntry
pd'
            Type
_                        -> Type -> ExpVal -> SymbolTableEntry
SParameter Type
ty ExpVal
val'
          Just SDummy{} | ExpVal -> Bool
isStr ExpVal
val' -> SymbolTableEntry
pd'
          Just SymbolTableEntry
_ ->
            let errStr :: Name -> Name
errStr Name
t =
                    Name
"Invalid PARAMETER statement for symbol \'" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
t Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"\'"
            in  Name -> SymbolTableEntry
forall a. HasCallStack => Name -> a
error (Name -> SymbolTableEntry) -> Name -> SymbolTableEntry
forall a b. (a -> b) -> a -> b
$ Name -> Name
errStr Name
symbol
    in  Name -> SymbolTableEntry -> SymbolTable -> SymbolTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
symbol SymbolTableEntry
entry SymbolTable
symt
  f SymbolTable
symt Declarator (Analysis a)
_ = SymbolTable
symt

handleDeclaration
  :: Data a
  => SymbolTable
  -> TypeSpec (Analysis a)
  -> AList Declarator (Analysis a)
  -> SymbolTable
handleDeclaration :: SymbolTable
-> TypeSpec (Analysis a)
-> AList Declarator (Analysis a)
-> SymbolTable
handleDeclaration SymbolTable
symTable TypeSpec (Analysis a)
typespec AList Declarator (Analysis a)
decls = (SymbolTable -> Declarator (Analysis a) -> SymbolTable)
-> SymbolTable -> [Declarator (Analysis a)] -> SymbolTable
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SymbolTable -> Declarator (Analysis a) -> SymbolTable
f SymbolTable
symTable (AList Declarator (Analysis a) -> [Declarator (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Declarator (Analysis a)
decls)
 where
  (TypeSpec Analysis a
_ SrcSpan
_ BaseType
bt Maybe (Selector (Analysis a))
selector) = TypeSpec (Analysis a)
typespec
  handleVarStar :: Name -> SymbolTable -> Type -> SymbolTable
handleVarStar Name
symbol SymbolTable
symt Type
ty' =
    let
      entry :: SymbolTableEntry
entry = case Name -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
symbol SymbolTable
symt of
        -- Entry found implies the name also appears in a
        -- preceding parameter statement. In case of ValStar
        -- selector, only type is updated.
        Just (SParameter Type
_ ExpVal
val) -> Type -> ExpVal -> SymbolTableEntry
SParameter Type
ty' ExpVal
val
        Just SymbolTableEntry
_                  -> Name -> SymbolTableEntry
forall a. HasCallStack => Name -> a
error
          (Name
symbol
          Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"is not a parameter. \
               \Only ParameterEntries are expected at this point."
          )
        Maybe SymbolTableEntry
Nothing -> Type -> Location -> SymbolTableEntry
SVariable (CharacterLen -> Int -> Type
TCharacter CharacterLen
CharLenStar Int
1) (Name
symbol, Int
0)
    in  Name -> SymbolTableEntry -> SymbolTable -> SymbolTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
symbol SymbolTableEntry
entry SymbolTable
symt
  -- don't care initial value at this moment
  f :: SymbolTable -> Declarator (Analysis a) -> SymbolTable
f SymbolTable
symt (DeclVariable Analysis a
_ SrcSpan
s Expression (Analysis a)
varExp Maybe (Expression (Analysis a))
charLength Maybe (Expression (Analysis a))
_) =
    let
      symbol :: Name
symbol = Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
srcName Expression (Analysis a)
varExp
      ty' :: Type
ty'    = BaseType -> Type
baseToType BaseType
bt
    in
      case (Maybe (Selector (Analysis a))
selector, Maybe (Expression (Analysis a))
charLength) of
        (Just (Selector Analysis a
_ SrcSpan
_ (Just (ExpValue Analysis a
_ SrcSpan
_ Value (Analysis a)
ValStar)) Maybe (Expression (Analysis a))
_), Maybe (Expression (Analysis a))
Nothing) ->
          Name -> SymbolTable -> Type -> SymbolTable
handleVarStar Name
symbol SymbolTable
symt Type
ty'
        (Maybe (Selector (Analysis a))
_, Just (ExpValue Analysis a
_ SrcSpan
_ Value (Analysis a)
ValStar)) -> Name -> SymbolTable -> Type -> SymbolTable
handleVarStar Name
symbol SymbolTable
symt Type
ty'
        (Maybe (Selector (Analysis a)), Maybe (Expression (Analysis a)))
_ ->
          let
            kind' :: Maybe Int
kind' = SymbolTable
-> TypeSpec (Analysis a)
-> Maybe (Expression (Analysis a))
-> Maybe Int
forall a.
SymbolTable
-> TypeSpec (Analysis a)
-> Maybe (Expression (Analysis a))
-> Maybe Int
getKind SymbolTable
symt TypeSpec (Analysis a)
typespec Maybe (Expression (Analysis a))
charLength
            ty'' :: Type
ty''  = Type -> Maybe Int -> Type
setTypeKind Type
ty' Maybe Int
kind'
            entry :: SymbolTableEntry
entry = case Name -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
symbol SymbolTable
symt of
              -- Entry found implies the name also appears in a
              -- preceding parameter statement or that the entry
              -- has already been defined. In the case of parameter
              -- only type and kind are updated, and the type and
              -- kind are checked in the case of already defined.
              Just (SParameter Type
_ ExpVal
val) -> Type -> ExpVal -> SymbolTableEntry
SParameter Type
ty'' ExpVal
val
              Just (SVariable (TArray Type
_ Maybe Dimensions
dims) Location
loc) ->
                Type -> Location -> SymbolTableEntry
SVariable (Type -> Maybe Dimensions -> Type
TArray Type
ty' Maybe Dimensions
dims) Location
loc
              Just v :: SymbolTableEntry
v@(SVariable Type
ty Location
loc) ->
                let errStr :: Name
errStr =
                        Name
"The second declaration of '"
                          Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
symbol
                          Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"' at line "
                          Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ SrcSpan -> Name
forall a. Show a => a -> Name
show SrcSpan
s
                          Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" does not have the same type as the first"
                in  if Type -> Constr
forall a. Data a => a -> Constr
toConstr Type
ty' Constr -> Constr -> Bool
forall a. Eq a => a -> a -> Bool
/= Type -> Constr
forall a. Data a => a -> Constr
toConstr Type
ty
                      then Name -> SymbolTableEntry
forall a. HasCallStack => Name -> a
error Name
errStr
                      else
                        let mk :: Maybe Int
mk = Type -> Maybe Int
getTypeKind Type
ty'
                        in  if Maybe Int
mk Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Type -> Maybe Int
getTypeKind Type
ty
                              then Type -> Location -> SymbolTableEntry
SVariable Type
ty'' Location
loc
                              else SymbolTableEntry
v
              Just SymbolTableEntry
_ -> Name -> SymbolTableEntry
forall a. HasCallStack => Name -> a
error
                (Name
symbol
                Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" is not a parameter nor array-type variable.\
                                         \ Invalid Fortran syntax at "
                Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ SrcSpan -> Name
forall a. Show a => a -> Name
show SrcSpan
s
                )
              Maybe SymbolTableEntry
Nothing -> Type -> Location -> SymbolTableEntry
SVariable Type
ty'' (Name
symbol, Int
0)
          in
            Name -> SymbolTableEntry -> SymbolTable -> SymbolTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
symbol SymbolTableEntry
entry SymbolTable
symt
  f SymbolTable
symt (DeclArray Analysis a
_ SrcSpan
_ Expression (Analysis a)
varExp AList DimensionDeclarator (Analysis a)
dimDecls Maybe (Expression (Analysis a))
charLength Maybe (Expression (Analysis a))
_) =
    let
      symbol :: Name
symbol = Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
srcName Expression (Analysis a)
varExp
      entry :: SymbolTableEntry
entry  = case Maybe (Expression (Analysis a))
charLength of
        Just (ExpValue Analysis a
_ SrcSpan
_ Value (Analysis a)
ValStar) ->
          Type -> Location -> SymbolTableEntry
SVariable (Type -> Maybe Dimensions -> Type
TArray (CharacterLen -> Int -> Type
TCharacter CharacterLen
CharLenStar Int
1) Maybe Dimensions
forall a. Maybe a
Nothing) (Name
symbol, Int
0)
        Maybe (Expression (Analysis a))
_ ->
          let
            kd :: Maybe Int
kd   = SymbolTable
-> TypeSpec (Analysis a)
-> Maybe (Expression (Analysis a))
-> Maybe Int
forall a.
SymbolTable
-> TypeSpec (Analysis a)
-> Maybe (Expression (Analysis a))
-> Maybe Int
getKind SymbolTable
symt TypeSpec (Analysis a)
typespec Maybe (Expression (Analysis a))
charLength
            dims :: Maybe Dimensions
dims = (DimensionDeclarator (Analysis a) -> Maybe (Int, Int))
-> [DimensionDeclarator (Analysis a)] -> Maybe Dimensions
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (SymbolTable -> DimensionDeclarator (Analysis a) -> Maybe (Int, Int)
forall a.
SymbolTable -> DimensionDeclarator (Analysis a) -> Maybe (Int, Int)
resolveDimensionDimensionDeclarator SymbolTable
symt)
                            (AList DimensionDeclarator (Analysis a)
-> [DimensionDeclarator (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList DimensionDeclarator (Analysis a)
dimDecls)
            ty :: Type
ty = Type -> Maybe Int -> Type
setTypeKind (BaseType -> Type
baseToType BaseType
bt) Maybe Int
kd
          in
            Type -> Location -> SymbolTableEntry
SVariable (Type -> Maybe Dimensions -> Type
TArray Type
ty Maybe Dimensions
dims) (Name
symbol, Int
0)
    in
      Name -> SymbolTableEntry -> SymbolTable -> SymbolTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
symbol SymbolTableEntry
entry SymbolTable
symt

updateDimensionDimensionDeclarator
  :: Name
  -> AList DimensionDeclarator (Analysis a)
  -> SymbolTable
  -> SymbolTable
updateDimensionDimensionDeclarator :: Name
-> AList DimensionDeclarator (Analysis a)
-> SymbolTable
-> SymbolTable
updateDimensionDimensionDeclarator Name
symbol AList DimensionDeclarator (Analysis a)
dimDecls SymbolTable
symTable =
  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 TArray{} Location
_) -> Name -> SymbolTable
forall a. HasCallStack => Name -> a
error
      (Name
symbol
      Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"is array-typed Varible. \
                 \Invalid fortran syntax (Duplicate DIMENSION attribute)"
      )
    Just (SVariable Type
ty Location
loc) ->
      let mdims :: Maybe Dimensions
mdims = (DimensionDeclarator (Analysis a) -> Maybe (Int, Int))
-> [DimensionDeclarator (Analysis a)] -> Maybe Dimensions
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (SymbolTable -> DimensionDeclarator (Analysis a) -> Maybe (Int, Int)
forall a.
SymbolTable -> DimensionDeclarator (Analysis a) -> Maybe (Int, Int)
resolveDimensionDimensionDeclarator SymbolTable
symTable)
                           (AList DimensionDeclarator (Analysis a)
-> [DimensionDeclarator (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList DimensionDeclarator (Analysis a)
dimDecls)
          entry :: SymbolTableEntry
entry = Type -> Location -> SymbolTableEntry
SVariable (Type -> Maybe Dimensions -> Type
TArray Type
ty Maybe Dimensions
mdims) Location
loc
      in  Name -> SymbolTableEntry -> SymbolTable -> SymbolTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
symbol SymbolTableEntry
entry SymbolTable
symTable
    Maybe SymbolTableEntry
_ -> SymbolTable
symTable

handleDimension
  :: Data a => SymbolTable -> AList Declarator (Analysis a) -> SymbolTable
handleDimension :: SymbolTable -> AList Declarator (Analysis a) -> SymbolTable
handleDimension SymbolTable
symTable AList Declarator (Analysis a)
decls = (SymbolTable -> Declarator (Analysis a) -> SymbolTable)
-> SymbolTable -> [Declarator (Analysis a)] -> SymbolTable
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SymbolTable -> Declarator (Analysis a) -> SymbolTable
forall a. SymbolTable -> Declarator (Analysis a) -> SymbolTable
f SymbolTable
symTable (AList Declarator (Analysis a) -> [Declarator (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Declarator (Analysis a)
decls)
 where
  f :: SymbolTable -> Declarator (Analysis a) -> SymbolTable
f SymbolTable
symt (DeclArray Analysis a
_ SrcSpan
_ Expression (Analysis a)
varExp AList DimensionDeclarator (Analysis a)
dimDecls Maybe (Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_) =
    Name
-> AList DimensionDeclarator (Analysis a)
-> SymbolTable
-> SymbolTable
forall a.
Name
-> AList DimensionDeclarator (Analysis a)
-> SymbolTable
-> SymbolTable
updateDimensionDimensionDeclarator (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
srcName Expression (Analysis a)
varExp) AList DimensionDeclarator (Analysis a)
dimDecls SymbolTable
symt
  f SymbolTable
symt Declarator (Analysis a)
_ = SymbolTable
symt

-- | Given symbol, list of Arguments and SymbolTable, it updates the relevant
-- variable in the SymbolTable to become an array with dimensions described by
-- the list of Arguments.
--
-- This function is needed to handle dimensions specifications within COMMONs,
-- because fortran-src doesn't support 'DimensionDeclarator's within COMMON blocks.
updateDimensionExpFunctionCall
  :: Name -> AList Argument (Analysis a) -> SymbolTable -> SymbolTable
updateDimensionExpFunctionCall :: Name -> AList Argument (Analysis a) -> SymbolTable -> SymbolTable
updateDimensionExpFunctionCall Name
symbol AList Argument (Analysis a)
args SymbolTable
symTable =
  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 TArray{} Location
_) -> Name -> SymbolTable
forall a. HasCallStack => Name -> a
error
      (Name
symbol
      Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" is array-typed VaribleEntry. \
                 \Invalid fortran syntax (Duplicate DIMENSION attribute)"
      )
    Just (SVariable Type
std Location
loc) ->
      let dims :: Maybe Dimensions
dims =
              (Argument (Analysis a) -> Maybe (Int, Int))
-> [Argument (Analysis a)] -> Maybe Dimensions
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (SymbolTable -> Argument (Analysis a) -> Maybe (Int, Int)
forall a. SymbolTable -> Argument (Analysis a) -> Maybe (Int, Int)
resolveDimensionExpFunctionCall SymbolTable
symTable) (AList Argument (Analysis a) -> [Argument (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Argument (Analysis a)
args)
          entry :: SymbolTableEntry
entry = Type -> Location -> SymbolTableEntry
SVariable (Type -> Maybe Dimensions -> Type
TArray Type
std Maybe Dimensions
dims) Location
loc
      in  Name -> SymbolTableEntry -> SymbolTable -> SymbolTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
symbol SymbolTableEntry
entry SymbolTable
symTable
    Just (SDummy Type
_) -> Name -> SymbolTable
forall a. HasCallStack => Name -> a
error
      (Name
symbol
      Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" is DummyVariableEntry. \
                 \Invalid fortran syntax (Dummy in COMMON dimension declaration)"
      )
    Maybe SymbolTableEntry
Nothing ->
      let dims :: Maybe Dimensions
dims =
              (Argument (Analysis a) -> Maybe (Int, Int))
-> [Argument (Analysis a)] -> Maybe Dimensions
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (SymbolTable -> Argument (Analysis a) -> Maybe (Int, Int)
forall a. SymbolTable -> Argument (Analysis a) -> Maybe (Int, Int)
resolveDimensionExpFunctionCall SymbolTable
symTable) (AList Argument (Analysis a) -> [Argument (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Argument (Analysis a)
args)
          -- Set default kind; there is no way to know it at this point
          entry :: SymbolTableEntry
entry = Type -> Location -> SymbolTableEntry
SVariable (Type -> Maybe Dimensions -> Type
TArray (Int -> Type
TInteger Int
4) Maybe Dimensions
dims) (Name
symbol, Int
0)
      in  Name -> SymbolTableEntry -> SymbolTable -> SymbolTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
symbol SymbolTableEntry
entry SymbolTable
symTable
    Maybe SymbolTableEntry
_ -> Name -> SymbolTable
forall a. HasCallStack => Name -> a
error
      (Name
symbol
      Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" was found in SymbolTable. This case is not possible, \
                 \because ExpFunctionCall as dimension declarator can only occur for \
                 \variables that occur after COMMON block in the code"
      )

-- | Given symbol, list of Indices and SymbolTable, it updates the relevant
-- variable in the SymbolTable to become an array with dimensions described by
-- the list of Indices.
--
-- This function is needed to handle dimensions specifications within COMMONs,
-- because fortran-src doesn't support 'DimensionDeclarator's within COMMON blocks.
updateDimensionExpSubscript
  :: Name -> AList Index (Analysis a) -> SymbolTable -> SymbolTable
updateDimensionExpSubscript :: Name -> AList Index (Analysis a) -> SymbolTable -> SymbolTable
updateDimensionExpSubscript Name
symbol AList Index (Analysis a)
indices SymbolTable
symTable =
  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 TArray{} Location
_) -> Name -> SymbolTable
forall a. HasCallStack => Name -> a
error
      (Name
symbol
      Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" is array-typed VaribleEntry. \
                 \Invalid fortran syntax (Duplicate DIMENSION attribute)"
      )
    Just (SVariable Type
std Location
loc) ->
      let dims :: Maybe Dimensions
dims =
              (Index (Analysis a) -> Maybe (Int, Int))
-> [Index (Analysis a)] -> Maybe Dimensions
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (SymbolTable -> Index (Analysis a) -> Maybe (Int, Int)
forall a. SymbolTable -> Index (Analysis a) -> Maybe (Int, Int)
resolveDimensionExpSubscript SymbolTable
symTable) (AList Index (Analysis a) -> [Index (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Index (Analysis a)
indices)
          entry :: SymbolTableEntry
entry = Type -> Location -> SymbolTableEntry
SVariable (Type -> Maybe Dimensions -> Type
TArray Type
std Maybe Dimensions
dims) Location
loc
      in  Name -> SymbolTableEntry -> SymbolTable -> SymbolTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
symbol SymbolTableEntry
entry SymbolTable
symTable
    Just (SDummy Type
_) -> Name -> SymbolTable
forall a. HasCallStack => Name -> a
error
      (Name
symbol
      Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" is DummyVariableEntry. \
                 \Invalid fortran syntax (Dummy in COMMON dimension declaration)"
      )
    Maybe SymbolTableEntry
Nothing ->
      let dims :: Maybe Dimensions
dims =
              (Index (Analysis a) -> Maybe (Int, Int))
-> [Index (Analysis a)] -> Maybe Dimensions
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (SymbolTable -> Index (Analysis a) -> Maybe (Int, Int)
forall a. SymbolTable -> Index (Analysis a) -> Maybe (Int, Int)
resolveDimensionExpSubscript SymbolTable
symTable) (AList Index (Analysis a) -> [Index (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Index (Analysis a)
indices)
          -- Set default kind; there is no way to know it at this point
          entry :: SymbolTableEntry
entry = Type -> Location -> SymbolTableEntry
SVariable (Type -> Maybe Dimensions -> Type
TArray (Int -> Type
TInteger Int
4) Maybe Dimensions
dims) (Name
symbol, Int
0)
      in  Name -> SymbolTableEntry -> SymbolTable -> SymbolTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
symbol SymbolTableEntry
entry SymbolTable
symTable
    Maybe SymbolTableEntry
_ -> Name -> SymbolTable
forall a. HasCallStack => Name -> a
error Name
"Invalid fortran syntax"

handleCommon
  :: Data a => SymbolTable -> AList CommonGroup (Analysis a) -> SymbolTable
handleCommon :: SymbolTable -> AList CommonGroup (Analysis a) -> SymbolTable
handleCommon SymbolTable
symTable AList CommonGroup (Analysis a)
alist = (SymbolTable -> CommonGroup (Analysis a) -> SymbolTable)
-> SymbolTable -> [CommonGroup (Analysis a)] -> SymbolTable
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SymbolTable -> CommonGroup (Analysis a) -> SymbolTable
forall a. SymbolTable -> CommonGroup (Analysis a) -> SymbolTable
f SymbolTable
symTable (AList CommonGroup (Analysis a) -> [CommonGroup (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList CommonGroup (Analysis a)
alist)
 where
  f :: SymbolTable -> CommonGroup (Analysis a) -> SymbolTable
f SymbolTable
symt (CommonGroup Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ AList Expression (Analysis a)
alist2) = (SymbolTable -> Expression (Analysis a) -> SymbolTable)
-> SymbolTable -> [Expression (Analysis a)] -> SymbolTable
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SymbolTable -> Expression (Analysis a) -> SymbolTable
forall a. SymbolTable -> Expression (Analysis a) -> SymbolTable
f2 SymbolTable
symt (AList Expression (Analysis a) -> [Expression (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Expression (Analysis a)
alist2)
   where
    f2 :: SymbolTable -> Expression (Analysis a) -> SymbolTable
f2 SymbolTable
symt2 (ExpFunctionCall Analysis a
_ SrcSpan
_ Expression (Analysis a)
varExp (Just AList Argument (Analysis a)
alist3)) =
      Name -> AList Argument (Analysis a) -> SymbolTable -> SymbolTable
forall a.
Name -> AList Argument (Analysis a) -> SymbolTable -> SymbolTable
updateDimensionExpFunctionCall (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
srcName Expression (Analysis a)
varExp) AList Argument (Analysis a)
alist3 SymbolTable
symt2
    f2 SymbolTable
symt2 (ExpSubscript Analysis a
_ SrcSpan
_ Expression (Analysis a)
varExp AList Index (Analysis a)
alist3) =
      Name -> AList Index (Analysis a) -> SymbolTable -> SymbolTable
forall a.
Name -> AList Index (Analysis a) -> SymbolTable -> SymbolTable
updateDimensionExpSubscript (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
srcName Expression (Analysis a)
varExp) AList Index (Analysis a)
alist3 SymbolTable
symt2
    f2 SymbolTable
symt2 Expression (Analysis a)
_ = SymbolTable
symt2

-- | Given a 'SymbolTable' and a 'Statement' found in a 'ProgramUnit', return a new 'SymbolTable'
-- with any newly defined symbols
stSymbols :: Data a => SymbolTable -> Statement (Analysis a) -> SymbolTable
stSymbols :: SymbolTable -> Statement (Analysis a) -> SymbolTable
stSymbols SymbolTable
symTable (StParameter Analysis a
_ SrcSpan
_ AList Declarator (Analysis a)
alist) = SymbolTable -> AList Declarator (Analysis a) -> SymbolTable
forall a.
Data a =>
SymbolTable -> AList Declarator (Analysis a) -> SymbolTable
handleParameter SymbolTable
symTable AList Declarator (Analysis a)
alist
stSymbols SymbolTable
symTable (StDeclaration Analysis a
_ SrcSpan
_ TypeSpec (Analysis a)
typespec Maybe (AList Attribute (Analysis a))
_ AList Declarator (Analysis a)
decls) =
  SymbolTable
-> TypeSpec (Analysis a)
-> AList Declarator (Analysis a)
-> SymbolTable
forall a.
Data a =>
SymbolTable
-> TypeSpec (Analysis a)
-> AList Declarator (Analysis a)
-> SymbolTable
handleDeclaration SymbolTable
symTable TypeSpec (Analysis a)
typespec AList Declarator (Analysis a)
decls
stSymbols SymbolTable
symTable (StDimension Analysis a
_ SrcSpan
_ AList Declarator (Analysis a)
decls     ) = SymbolTable -> AList Declarator (Analysis a) -> SymbolTable
forall a.
Data a =>
SymbolTable -> AList Declarator (Analysis a) -> SymbolTable
handleDimension SymbolTable
symTable AList Declarator (Analysis a)
decls
stSymbols SymbolTable
symTable (StCommon    Analysis a
_ SrcSpan
_ AList CommonGroup (Analysis a)
alist     ) = SymbolTable -> AList CommonGroup (Analysis a) -> SymbolTable
forall a.
Data a =>
SymbolTable -> AList CommonGroup (Analysis a) -> SymbolTable
handleCommon SymbolTable
symTable AList CommonGroup (Analysis a)
alist
stSymbols SymbolTable
symTable (StInclude Analysis a
_ SrcSpan
_ Expression (Analysis a)
_ (Just [Block (Analysis a)]
bls)) = (SymbolTable -> Block (Analysis a) -> SymbolTable)
-> SymbolTable -> [Block (Analysis a)] -> SymbolTable
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SymbolTable -> Block (Analysis a) -> SymbolTable
forall a.
Data a =>
SymbolTable -> Block (Analysis a) -> SymbolTable
blSymbols SymbolTable
symTable [Block (Analysis a)]
bls
stSymbols SymbolTable
symTable Statement (Analysis a)
_                            = SymbolTable
symTable

-- | Given a 'Bool', 'SymbolTable' and a 'ProgramUnit', return an updated
-- 'SymbolTable' containing symbols defined in 'ProgramUnit' signature, e.g.
--   integer function fname() -> symbol table containing 'fname'
-- The first argument flags whether to traverse declarations for the function return
-- type, allowing us to avoid traversing the top level program unit twice
puSymbols
  :: Data a => Bool -> SymbolTable -> ProgramUnit (Analysis a) -> SymbolTable
puSymbols :: Bool -> SymbolTable -> ProgramUnit (Analysis a) -> SymbolTable
puSymbols Bool
_ SymbolTable
symt (PUFunction Analysis a
_ SrcSpan
_ (Just TypeSpec (Analysis a)
typespec) PrefixSuffix (Analysis a)
_ Name
symbol Maybe (AList Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_ [Block (Analysis a)]
_ Maybe [ProgramUnit (Analysis a)]
_) =
  let entryType :: Type
entryType = SymbolTable -> TypeSpec (Analysis a) -> Type
forall a. SymbolTable -> TypeSpec (Analysis a) -> Type
typeSpecToScalarType SymbolTable
symt TypeSpec (Analysis a)
typespec
      entryLoc :: Location
entryLoc  = (Name
symbol, Int
0)
      entry :: SymbolTableEntry
entry     = Type -> Location -> SymbolTableEntry
SVariable Type
entryType Location
entryLoc
  in  Name -> SymbolTableEntry -> SymbolTable -> SymbolTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
symbol SymbolTableEntry
entry SymbolTable
symt
puSymbols Bool
getDecls SymbolTable
symt (PUFunction Analysis a
_ SrcSpan
_ Maybe (TypeSpec (Analysis a))
Nothing PrefixSuffix (Analysis a)
_ Name
symbol Maybe (AList Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_ [Block (Analysis a)]
bls Maybe [ProgramUnit (Analysis a)]
_) =
  if Bool
getDecls then (SymbolTable -> Block (Analysis a) -> SymbolTable)
-> SymbolTable -> [Block (Analysis a)] -> SymbolTable
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SymbolTable -> Block (Analysis a) -> SymbolTable
forall a. SymbolTable -> Block (Analysis a) -> SymbolTable
handler SymbolTable
symt [Block (Analysis a)]
bls else SymbolTable
symt
 where
  handler :: SymbolTable -> Block (Analysis a) -> SymbolTable
handler SymbolTable
symt' (BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ (StDeclaration Analysis a
_ SrcSpan
_ TypeSpec (Analysis a)
typespec Maybe (AList Attribute (Analysis a))
_ AList Declarator (Analysis a)
decls)) =
    let mty :: Maybe Type
mty = SymbolTable
-> Name
-> TypeSpec (Analysis a)
-> [Declarator (Analysis a)]
-> Maybe Type
forall a.
SymbolTable
-> Name
-> TypeSpec (Analysis a)
-> [Declarator (Analysis a)]
-> Maybe Type
declToType SymbolTable
symt' Name
symbol TypeSpec (Analysis a)
typespec ([Declarator (Analysis a)] -> Maybe Type)
-> [Declarator (Analysis a)] -> Maybe Type
forall a b. (a -> b) -> a -> b
$ AList Declarator (Analysis a) -> [Declarator (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Declarator (Analysis a)
decls
    in  case Maybe Type
mty of
          Just Type
ty ->
            let entryLoc :: Location
entryLoc = (Name
symbol, Int
0)
                entry :: SymbolTableEntry
entry    = Type -> Location -> SymbolTableEntry
SVariable Type
ty Location
entryLoc
            in  Name -> SymbolTableEntry -> SymbolTable -> SymbolTable
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
symbol SymbolTableEntry
entry SymbolTable
symt'
          Maybe Type
Nothing -> SymbolTable
symt'
  handler SymbolTable
symt' Block (Analysis a)
_ = SymbolTable
symt'
puSymbols Bool
_ SymbolTable
symt ProgramUnit (Analysis a)
_ = SymbolTable
symt

-- | Given a TypeSpec and list of Declarators, search for a name in that list
-- and return the resolved type if there
declToType
  :: SymbolTable
  -> Name
  -> TypeSpec (Analysis a)
  -> [Declarator (Analysis a)]
  -> Maybe Type
declToType :: SymbolTable
-> Name
-> TypeSpec (Analysis a)
-> [Declarator (Analysis a)]
-> Maybe Type
declToType SymbolTable
symt Name
name TypeSpec (Analysis a)
tyspec (Declarator (Analysis a)
d : [Declarator (Analysis a)]
ds) = if Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Declarator (Analysis a) -> Name
forall a. Declarator a -> Name
getName Declarator (Analysis a)
d
  then Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ Declarator (Analysis a) -> Type
toType Declarator (Analysis a)
d
  else SymbolTable
-> Name
-> TypeSpec (Analysis a)
-> [Declarator (Analysis a)]
-> Maybe Type
forall a.
SymbolTable
-> Name
-> TypeSpec (Analysis a)
-> [Declarator (Analysis a)]
-> Maybe Type
declToType SymbolTable
symt Name
name TypeSpec (Analysis a)
tyspec [Declarator (Analysis a)]
ds
 where
  getName :: Declarator a -> Name
getName (DeclArray a
_ SrcSpan
_ (ExpValue a
_ SrcSpan
_ (ValVariable Name
str)) AList DimensionDeclarator a
_ Maybe (Expression a)
_ Maybe (Expression a)
_) = Name
str
  getName (DeclVariable a
_ SrcSpan
_ (ExpValue a
_ SrcSpan
_ (ValVariable Name
str)) Maybe (Expression a)
_ Maybe (Expression a)
_) = Name
str
  getName Declarator a
_ = Name -> Name
forall a. HasCallStack => Name -> a
error Name
"Unexpected declaration expression"
  toType :: Declarator (Analysis a) -> Type
toType (DeclArray Analysis a
_ SrcSpan
_ Expression (Analysis a)
_ AList DimensionDeclarator (Analysis a)
dims Maybe (Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_) =
    SymbolTable
-> [DimensionDeclarator (Analysis a)]
-> TypeSpec (Analysis a)
-> Type
forall a.
SymbolTable
-> [DimensionDeclarator (Analysis a)]
-> TypeSpec (Analysis a)
-> Type
typeSpecToArrayType SymbolTable
symt (AList DimensionDeclarator (Analysis a)
-> [DimensionDeclarator (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList DimensionDeclarator (Analysis a)
dims) TypeSpec (Analysis a)
tyspec
  toType DeclVariable{} = SymbolTable -> TypeSpec (Analysis a) -> Type
forall a. SymbolTable -> TypeSpec (Analysis a) -> Type
typeSpecToScalarType SymbolTable
symt TypeSpec (Analysis a)
tyspec
declToType SymbolTable
_ Name
_ TypeSpec (Analysis a)
_ [] = Maybe Type
forall a. Maybe a
Nothing

-- | Update SymbolTable for a given block, traverse statements to get
-- declarations and interfaces to get function signatures.
blSymbols :: Data a => SymbolTable -> Block (Analysis a) -> SymbolTable
blSymbols :: SymbolTable -> Block (Analysis a) -> SymbolTable
blSymbols SymbolTable
symt (BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ Statement (Analysis a)
st     ) = SymbolTable -> Statement (Analysis a) -> SymbolTable
forall a.
Data a =>
SymbolTable -> Statement (Analysis a) -> SymbolTable
stSymbols SymbolTable
symt Statement (Analysis a)
st
blSymbols SymbolTable
symt (BlInterface Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ Bool
_ [ProgramUnit (Analysis a)]
pus [Block (Analysis a)]
_) = (SymbolTable -> ProgramUnit (Analysis a) -> SymbolTable)
-> SymbolTable -> [ProgramUnit (Analysis a)] -> SymbolTable
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Bool -> SymbolTable -> ProgramUnit (Analysis a) -> SymbolTable
forall a.
Data a =>
Bool -> SymbolTable -> ProgramUnit (Analysis a) -> SymbolTable
puSymbols Bool
True) SymbolTable
symt [ProgramUnit (Analysis a)]
pus
blSymbols SymbolTable
symt Block (Analysis a)
_                           = SymbolTable
symt

-- | Given a 'ProgramUnit', generate a 'SymbolTable' for all of the non-intrisic symbols
collectSymbols :: Data a => ProgramUnit (Analysis a) -> SymbolTable
collectSymbols :: ProgramUnit (Analysis a) -> SymbolTable
collectSymbols ProgramUnit (Analysis a)
pu =
  let puSignatureSymbols :: SymbolTable
puSignatureSymbols = Bool -> SymbolTable -> ProgramUnit (Analysis a) -> SymbolTable
forall a.
Data a =>
Bool -> SymbolTable -> ProgramUnit (Analysis a) -> SymbolTable
puSymbols Bool
False SymbolTable
forall k a. Map k a
M.empty ProgramUnit (Analysis a)
pu
  in  (SymbolTable -> Block (Analysis a) -> SymbolTable)
-> SymbolTable -> [Block (Analysis a)] -> SymbolTable
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SymbolTable -> Block (Analysis a) -> SymbolTable
forall a.
Data a =>
SymbolTable -> Block (Analysis a) -> SymbolTable
blSymbols SymbolTable
puSignatureSymbols ([Block (Analysis a)] -> SymbolTable)
-> [Block (Analysis a)] -> SymbolTable
forall a b. (a -> b) -> a -> b
$ ProgramUnit (Analysis a) -> [Block (Analysis a)]
forall a. ProgramUnit a -> [Block a]
programUnitBody ProgramUnit (Analysis a)
pu