{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}

module Language.Fortran.Vars.Types
  ( module Language.Fortran.Vars.Types.SymbolTable
  , module Language.Fortran.Vars.Types
  , Type
  , SemType(..)
  , Dim(..), Dims(..), Dimensions, dimensionsToTuples
  , dimsTraverse, dimsLength
  , CharacterLen(..)
  , Kind
  , ExpVal(..)
  )
where

import Language.Fortran.Vars.Types.SymbolTable

import           Language.Fortran.Common.Array ( dimsTraverse, dimsLength )
import           Language.Fortran.Vars.Orphans()
import           Language.Fortran.Vars.Rep
import           Data.Aeson                     ( FromJSON
                                                , ToJSON
                                                )
import           Data.Data                      ( Data )
import           Data.Map                       ( Map )
import           Data.Typeable                  ( Typeable )
import           GHC.Generics                   ( Generic )
import           Language.Fortran.AST           ( Name
                                                , ProgramUnitName
                                                , Expression
                                                )
import           Language.Fortran.Util.Position ( SrcSpan(..)
                                                , Position(..)
                                                )

-- | The declared lifetimes of the variables in memory
data StorageClass
  = Static
  | Automatic
  | Constant
  | Common
  | Unspecified
  deriving (StorageClass -> StorageClass -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageClass -> StorageClass -> Bool
$c/= :: StorageClass -> StorageClass -> Bool
== :: StorageClass -> StorageClass -> Bool
$c== :: StorageClass -> StorageClass -> Bool
Eq, Eq StorageClass
StorageClass -> StorageClass -> Bool
StorageClass -> StorageClass -> Ordering
StorageClass -> StorageClass -> StorageClass
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StorageClass -> StorageClass -> StorageClass
$cmin :: StorageClass -> StorageClass -> StorageClass
max :: StorageClass -> StorageClass -> StorageClass
$cmax :: StorageClass -> StorageClass -> StorageClass
>= :: StorageClass -> StorageClass -> Bool
$c>= :: StorageClass -> StorageClass -> Bool
> :: StorageClass -> StorageClass -> Bool
$c> :: StorageClass -> StorageClass -> Bool
<= :: StorageClass -> StorageClass -> Bool
$c<= :: StorageClass -> StorageClass -> Bool
< :: StorageClass -> StorageClass -> Bool
$c< :: StorageClass -> StorageClass -> Bool
compare :: StorageClass -> StorageClass -> Ordering
$ccompare :: StorageClass -> StorageClass -> Ordering
Ord, Int -> StorageClass -> ShowS
[StorageClass] -> ShowS
StorageClass -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [StorageClass] -> ShowS
$cshowList :: [StorageClass] -> ShowS
show :: StorageClass -> FilePath
$cshow :: StorageClass -> FilePath
showsPrec :: Int -> StorageClass -> ShowS
$cshowsPrec :: Int -> StorageClass -> ShowS
Show, Typeable StorageClass
StorageClass -> DataType
StorageClass -> Constr
(forall b. Data b => b -> b) -> StorageClass -> StorageClass
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> StorageClass -> u
forall u. (forall d. Data d => d -> u) -> StorageClass -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StorageClass -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StorageClass -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StorageClass -> m StorageClass
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StorageClass -> m StorageClass
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StorageClass
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StorageClass -> c StorageClass
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StorageClass)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StorageClass)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StorageClass -> m StorageClass
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StorageClass -> m StorageClass
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StorageClass -> m StorageClass
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StorageClass -> m StorageClass
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StorageClass -> m StorageClass
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StorageClass -> m StorageClass
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StorageClass -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StorageClass -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> StorageClass -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StorageClass -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StorageClass -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StorageClass -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StorageClass -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StorageClass -> r
gmapT :: (forall b. Data b => b -> b) -> StorageClass -> StorageClass
$cgmapT :: (forall b. Data b => b -> b) -> StorageClass -> StorageClass
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StorageClass)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StorageClass)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StorageClass)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StorageClass)
dataTypeOf :: StorageClass -> DataType
$cdataTypeOf :: StorageClass -> DataType
toConstr :: StorageClass -> Constr
$ctoConstr :: StorageClass -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StorageClass
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StorageClass
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StorageClass -> c StorageClass
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StorageClass -> c StorageClass
Data, Typeable, forall x. Rep StorageClass x -> StorageClass
forall x. StorageClass -> Rep StorageClass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StorageClass x -> StorageClass
$cfrom :: forall x. StorageClass -> Rep StorageClass x
Generic)

instance FromJSON StorageClass
instance ToJSON StorageClass

-- | Structure to hold information about the named blocks of memory
-- in the program
data MemoryBlock = MemoryBlock
  { MemoryBlock -> Maybe Int
blockSize    :: Maybe Int -- ^ Nothing for when block is dynamically sized
  , MemoryBlock -> StorageClass
storageClass :: StorageClass
  , MemoryBlock -> [FilePath]
variables    :: [Name]
  } deriving (MemoryBlock -> MemoryBlock -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryBlock -> MemoryBlock -> Bool
$c/= :: MemoryBlock -> MemoryBlock -> Bool
== :: MemoryBlock -> MemoryBlock -> Bool
$c== :: MemoryBlock -> MemoryBlock -> Bool
Eq, Eq MemoryBlock
MemoryBlock -> MemoryBlock -> Bool
MemoryBlock -> MemoryBlock -> Ordering
MemoryBlock -> MemoryBlock -> MemoryBlock
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MemoryBlock -> MemoryBlock -> MemoryBlock
$cmin :: MemoryBlock -> MemoryBlock -> MemoryBlock
max :: MemoryBlock -> MemoryBlock -> MemoryBlock
$cmax :: MemoryBlock -> MemoryBlock -> MemoryBlock
>= :: MemoryBlock -> MemoryBlock -> Bool
$c>= :: MemoryBlock -> MemoryBlock -> Bool
> :: MemoryBlock -> MemoryBlock -> Bool
$c> :: MemoryBlock -> MemoryBlock -> Bool
<= :: MemoryBlock -> MemoryBlock -> Bool
$c<= :: MemoryBlock -> MemoryBlock -> Bool
< :: MemoryBlock -> MemoryBlock -> Bool
$c< :: MemoryBlock -> MemoryBlock -> Bool
compare :: MemoryBlock -> MemoryBlock -> Ordering
$ccompare :: MemoryBlock -> MemoryBlock -> Ordering
Ord, Int -> MemoryBlock -> ShowS
[MemoryBlock] -> ShowS
MemoryBlock -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MemoryBlock] -> ShowS
$cshowList :: [MemoryBlock] -> ShowS
show :: MemoryBlock -> FilePath
$cshow :: MemoryBlock -> FilePath
showsPrec :: Int -> MemoryBlock -> ShowS
$cshowsPrec :: Int -> MemoryBlock -> ShowS
Show, Typeable MemoryBlock
MemoryBlock -> DataType
MemoryBlock -> Constr
(forall b. Data b => b -> b) -> MemoryBlock -> MemoryBlock
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> MemoryBlock -> u
forall u. (forall d. Data d => d -> u) -> MemoryBlock -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MemoryBlock -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MemoryBlock -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MemoryBlock -> m MemoryBlock
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MemoryBlock -> m MemoryBlock
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MemoryBlock
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MemoryBlock -> c MemoryBlock
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MemoryBlock)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MemoryBlock)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MemoryBlock -> m MemoryBlock
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MemoryBlock -> m MemoryBlock
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MemoryBlock -> m MemoryBlock
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MemoryBlock -> m MemoryBlock
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MemoryBlock -> m MemoryBlock
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MemoryBlock -> m MemoryBlock
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MemoryBlock -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MemoryBlock -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> MemoryBlock -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MemoryBlock -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MemoryBlock -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MemoryBlock -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MemoryBlock -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MemoryBlock -> r
gmapT :: (forall b. Data b => b -> b) -> MemoryBlock -> MemoryBlock
$cgmapT :: (forall b. Data b => b -> b) -> MemoryBlock -> MemoryBlock
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MemoryBlock)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MemoryBlock)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MemoryBlock)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MemoryBlock)
dataTypeOf :: MemoryBlock -> DataType
$cdataTypeOf :: MemoryBlock -> DataType
toConstr :: MemoryBlock -> Constr
$ctoConstr :: MemoryBlock -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MemoryBlock
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MemoryBlock
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MemoryBlock -> c MemoryBlock
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MemoryBlock -> c MemoryBlock
Data, Typeable, forall x. Rep MemoryBlock x -> MemoryBlock
forall x. MemoryBlock -> Rep MemoryBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MemoryBlock x -> MemoryBlock
$cfrom :: forall x. MemoryBlock -> Rep MemoryBlock x
Generic)

instance FromJSON MemoryBlock
instance ToJSON MemoryBlock

-- | Map from a structure name to its internal structure, specifying members
-- and their corresponding type. This can then be used to check the type of a
-- data reference expression.
type StructureTable = Map String Structure

-- List of structure fields forming a structure
type Structure = [StructureTableEntry]

-- | Data structurue for a single field of a structure
data StructureTableEntry
  = FieldEntry String Type
  | UnionEntry [Structure]
  deriving (StructureTableEntry -> StructureTableEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StructureTableEntry -> StructureTableEntry -> Bool
$c/= :: StructureTableEntry -> StructureTableEntry -> Bool
== :: StructureTableEntry -> StructureTableEntry -> Bool
$c== :: StructureTableEntry -> StructureTableEntry -> Bool
Eq, Int -> StructureTableEntry -> ShowS
Structure -> ShowS
StructureTableEntry -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: Structure -> ShowS
$cshowList :: Structure -> ShowS
show :: StructureTableEntry -> FilePath
$cshow :: StructureTableEntry -> FilePath
showsPrec :: Int -> StructureTableEntry -> ShowS
$cshowsPrec :: Int -> StructureTableEntry -> ShowS
Show, Typeable StructureTableEntry
StructureTableEntry -> DataType
StructureTableEntry -> Constr
(forall b. Data b => b -> b)
-> StructureTableEntry -> StructureTableEntry
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> StructureTableEntry -> u
forall u.
(forall d. Data d => d -> u) -> StructureTableEntry -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StructureTableEntry -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StructureTableEntry -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StructureTableEntry -> m StructureTableEntry
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StructureTableEntry -> m StructureTableEntry
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StructureTableEntry
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StructureTableEntry
-> c StructureTableEntry
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StructureTableEntry)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StructureTableEntry)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StructureTableEntry -> m StructureTableEntry
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StructureTableEntry -> m StructureTableEntry
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StructureTableEntry -> m StructureTableEntry
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StructureTableEntry -> m StructureTableEntry
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StructureTableEntry -> m StructureTableEntry
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StructureTableEntry -> m StructureTableEntry
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StructureTableEntry -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StructureTableEntry -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> StructureTableEntry -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> StructureTableEntry -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StructureTableEntry -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StructureTableEntry -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StructureTableEntry -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StructureTableEntry -> r
gmapT :: (forall b. Data b => b -> b)
-> StructureTableEntry -> StructureTableEntry
$cgmapT :: (forall b. Data b => b -> b)
-> StructureTableEntry -> StructureTableEntry
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StructureTableEntry)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StructureTableEntry)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StructureTableEntry)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StructureTableEntry)
dataTypeOf :: StructureTableEntry -> DataType
$cdataTypeOf :: StructureTableEntry -> DataType
toConstr :: StructureTableEntry -> Constr
$ctoConstr :: StructureTableEntry -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StructureTableEntry
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StructureTableEntry
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StructureTableEntry
-> c StructureTableEntry
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StructureTableEntry
-> c StructureTableEntry
Data)

-- | Mapping from the name of a memory block to the information about it
type StorageTable = Map MemoryBlockName MemoryBlock

-- | The model to represent an individual 'Language.Fortran.AST.ProgramUnit'
type ProgramUnitModel = (SymbolTable, StorageTable)

-- | Mapping from the name of a 'Language.Fortran.AST.ProgramUnit' to
-- its 'ProgramUnitModel'
type ProgramFileModel = Map ProgramUnitName ProgramUnitModel

-- | Mapping from name of a program unit to relevant structure table
type ProgramStructureTables = Map ProgramUnitName StructureTable

data TypeError
  = TypeError FilePath SrcSpan String
  | UnknownType SrcSpan
  | UnboundVariable Name
  | UnknownField String
  deriving (TypeError -> TypeError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeError -> TypeError -> Bool
$c/= :: TypeError -> TypeError -> Bool
== :: TypeError -> TypeError -> Bool
$c== :: TypeError -> TypeError -> Bool
Eq, Eq TypeError
TypeError -> TypeError -> Bool
TypeError -> TypeError -> Ordering
TypeError -> TypeError -> TypeError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypeError -> TypeError -> TypeError
$cmin :: TypeError -> TypeError -> TypeError
max :: TypeError -> TypeError -> TypeError
$cmax :: TypeError -> TypeError -> TypeError
>= :: TypeError -> TypeError -> Bool
$c>= :: TypeError -> TypeError -> Bool
> :: TypeError -> TypeError -> Bool
$c> :: TypeError -> TypeError -> Bool
<= :: TypeError -> TypeError -> Bool
$c<= :: TypeError -> TypeError -> Bool
< :: TypeError -> TypeError -> Bool
$c< :: TypeError -> TypeError -> Bool
compare :: TypeError -> TypeError -> Ordering
$ccompare :: TypeError -> TypeError -> Ordering
Ord, Int -> TypeError -> ShowS
[TypeError] -> ShowS
TypeError -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TypeError] -> ShowS
$cshowList :: [TypeError] -> ShowS
show :: TypeError -> FilePath
$cshow :: TypeError -> FilePath
showsPrec :: Int -> TypeError -> ShowS
$cshowsPrec :: Int -> TypeError -> ShowS
Show, forall x. Rep TypeError x -> TypeError
forall x. TypeError -> Rep TypeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeError x -> TypeError
$cfrom :: forall x. TypeError -> Rep TypeError x
Generic)

instance ToJSON TypeError
instance FromJSON TypeError

-- | Construct a 'TypeError' using a 'SrcSpan', using the 'FilePath'.
typeError :: SrcSpan -> String -> TypeError
typeError :: SrcSpan -> FilePath -> TypeError
typeError SrcSpan
sp = let SrcSpan Position
p Position
_ = SrcSpan
sp in FilePath -> SrcSpan -> FilePath -> TypeError
TypeError (Position -> FilePath
posFilePath Position
p) SrcSpan
sp

type TypeOf a = Expression a -> Either TypeError Type

dimensionsToTuples' :: Dimensions -> [(Int, Int)]
dimensionsToTuples' :: Dimensions -> [(Int, Int)]
dimensionsToTuples' Dimensions
dims =
    case Dimensions -> Maybe [(Int, Int)]
dimensionsToTuples Dimensions
dims of
      Maybe [(Int, Int)]
Nothing    -> []
      Just [(Int, Int)]
dims' -> [(Int, Int)]
dims'

-- | Attempt to turn a list of evaluated array bounds which may include unknown
--   bounds, into a list of known bounds. Any unknown bounds will result in a
--   'Nothing'.
getStaticArrayBounds :: Traversable t => Dims t (Maybe a) -> Maybe (Dims t a)
getStaticArrayBounds :: forall (t :: * -> *) a.
Traversable t =>
Dims t (Maybe a) -> Maybe (Dims t a)
getStaticArrayBounds = forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
Dims t (f a) -> f (Dims t a)
dimsTraverse