{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Fortran.Analysis.SemanticTypes where
import Data.Data ( Data, Typeable )
import Control.DeepSeq ( NFData )
import GHC.Generics ( Generic )
import Language.Fortran.AST ( BaseType(..)
, Kind
, Expression(..)
, Value(..)
, TypeSpec(..)
, Selector(..) )
import Language.Fortran.Util.Position ( SrcSpan(..) )
import Language.Fortran.Version ( FortranVersion(..) )
import Data.Binary ( Binary )
import Text.PrettyPrint.GenericPretty ( Out(..) )
import Text.PrettyPrint ( (<+>), parens )
import Language.Fortran.PrettyPrint ( Pretty(..) )
data SemType
= TInteger Kind
| TReal Kind
| TComplex Kind
| TLogical Kind
| TByte Kind
| TCharacter CharacterLen Kind
| TArray SemType (Maybe Dimensions)
| TCustom String
deriving (SemType -> SemType -> Bool
(SemType -> SemType -> Bool)
-> (SemType -> SemType -> Bool) -> Eq SemType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemType -> SemType -> Bool
$c/= :: SemType -> SemType -> Bool
== :: SemType -> SemType -> Bool
$c== :: SemType -> SemType -> Bool
Eq, Eq SemType
Eq SemType
-> (SemType -> SemType -> Ordering)
-> (SemType -> SemType -> Bool)
-> (SemType -> SemType -> Bool)
-> (SemType -> SemType -> Bool)
-> (SemType -> SemType -> Bool)
-> (SemType -> SemType -> SemType)
-> (SemType -> SemType -> SemType)
-> Ord SemType
SemType -> SemType -> Bool
SemType -> SemType -> Ordering
SemType -> SemType -> SemType
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 :: SemType -> SemType -> SemType
$cmin :: SemType -> SemType -> SemType
max :: SemType -> SemType -> SemType
$cmax :: SemType -> SemType -> SemType
>= :: SemType -> SemType -> Bool
$c>= :: SemType -> SemType -> Bool
> :: SemType -> SemType -> Bool
$c> :: SemType -> SemType -> Bool
<= :: SemType -> SemType -> Bool
$c<= :: SemType -> SemType -> Bool
< :: SemType -> SemType -> Bool
$c< :: SemType -> SemType -> Bool
compare :: SemType -> SemType -> Ordering
$ccompare :: SemType -> SemType -> Ordering
Ord, Kind -> SemType -> ShowS
[SemType] -> ShowS
SemType -> String
(Kind -> SemType -> ShowS)
-> (SemType -> String) -> ([SemType] -> ShowS) -> Show SemType
forall a.
(Kind -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemType] -> ShowS
$cshowList :: [SemType] -> ShowS
show :: SemType -> String
$cshow :: SemType -> String
showsPrec :: Kind -> SemType -> ShowS
$cshowsPrec :: Kind -> SemType -> ShowS
Show, Typeable SemType
Typeable SemType
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SemType -> c SemType)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SemType)
-> (SemType -> Constr)
-> (SemType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SemType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SemType))
-> ((forall b. Data b => b -> b) -> SemType -> SemType)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SemType -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SemType -> r)
-> (forall u. (forall d. Data d => d -> u) -> SemType -> [u])
-> (forall u. Kind -> (forall d. Data d => d -> u) -> SemType -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SemType -> m SemType)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SemType -> m SemType)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SemType -> m SemType)
-> Data SemType
SemType -> DataType
SemType -> Constr
(forall b. Data b => b -> b) -> SemType -> SemType
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. Kind -> (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. Kind -> (forall d. Data d => d -> u) -> SemType -> u
forall u. (forall d. Data d => d -> u) -> SemType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SemType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SemType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SemType -> m SemType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SemType -> m SemType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SemType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SemType -> c SemType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SemType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SemType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SemType -> m SemType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SemType -> m SemType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SemType -> m SemType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SemType -> m SemType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SemType -> m SemType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SemType -> m SemType
gmapQi :: forall u. Kind -> (forall d. Data d => d -> u) -> SemType -> u
$cgmapQi :: forall u. Kind -> (forall d. Data d => d -> u) -> SemType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SemType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SemType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SemType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SemType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SemType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SemType -> r
gmapT :: (forall b. Data b => b -> b) -> SemType -> SemType
$cgmapT :: (forall b. Data b => b -> b) -> SemType -> SemType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SemType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SemType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SemType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SemType)
dataTypeOf :: SemType -> DataType
$cdataTypeOf :: SemType -> DataType
toConstr :: SemType -> Constr
$ctoConstr :: SemType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SemType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SemType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SemType -> c SemType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SemType -> c SemType
Data, Typeable, (forall x. SemType -> Rep SemType x)
-> (forall x. Rep SemType x -> SemType) -> Generic SemType
forall x. Rep SemType x -> SemType
forall x. SemType -> Rep SemType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SemType x -> SemType
$cfrom :: forall x. SemType -> Rep SemType x
Generic)
instance Binary SemType
instance Out SemType
instance Pretty SemType where
pprint' :: FortranVersion -> SemType -> Doc
pprint' FortranVersion
v = \case
TInteger Kind
_ -> Doc
"integer"
TReal Kind
_ -> Doc
"real"
TComplex Kind
_ -> Doc
"complex"
TLogical Kind
_ -> Doc
"logical"
TByte Kind
_ -> Doc
"byte"
TCharacter CharacterLen
_ Kind
_ -> Doc
"character"
TArray SemType
st Maybe Dimensions
_ -> FortranVersion -> SemType -> Doc
forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v SemType
st Doc -> Doc -> Doc
<+> Doc -> Doc
parens Doc
"(A)"
TCustom String
str -> FortranVersion -> BaseType -> Doc
forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v (String -> BaseType
TypeCustom String
str)
type Dimensions = [(Int, Int)]
data CharacterLen = CharLenStar
| CharLenColon
| CharLenExp
| CharLenInt Int
deriving (Eq CharacterLen
Eq CharacterLen
-> (CharacterLen -> CharacterLen -> Ordering)
-> (CharacterLen -> CharacterLen -> Bool)
-> (CharacterLen -> CharacterLen -> Bool)
-> (CharacterLen -> CharacterLen -> Bool)
-> (CharacterLen -> CharacterLen -> Bool)
-> (CharacterLen -> CharacterLen -> CharacterLen)
-> (CharacterLen -> CharacterLen -> CharacterLen)
-> Ord CharacterLen
CharacterLen -> CharacterLen -> Bool
CharacterLen -> CharacterLen -> Ordering
CharacterLen -> CharacterLen -> CharacterLen
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 :: CharacterLen -> CharacterLen -> CharacterLen
$cmin :: CharacterLen -> CharacterLen -> CharacterLen
max :: CharacterLen -> CharacterLen -> CharacterLen
$cmax :: CharacterLen -> CharacterLen -> CharacterLen
>= :: CharacterLen -> CharacterLen -> Bool
$c>= :: CharacterLen -> CharacterLen -> Bool
> :: CharacterLen -> CharacterLen -> Bool
$c> :: CharacterLen -> CharacterLen -> Bool
<= :: CharacterLen -> CharacterLen -> Bool
$c<= :: CharacterLen -> CharacterLen -> Bool
< :: CharacterLen -> CharacterLen -> Bool
$c< :: CharacterLen -> CharacterLen -> Bool
compare :: CharacterLen -> CharacterLen -> Ordering
$ccompare :: CharacterLen -> CharacterLen -> Ordering
Ord, CharacterLen -> CharacterLen -> Bool
(CharacterLen -> CharacterLen -> Bool)
-> (CharacterLen -> CharacterLen -> Bool) -> Eq CharacterLen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharacterLen -> CharacterLen -> Bool
$c/= :: CharacterLen -> CharacterLen -> Bool
== :: CharacterLen -> CharacterLen -> Bool
$c== :: CharacterLen -> CharacterLen -> Bool
Eq, Kind -> CharacterLen -> ShowS
[CharacterLen] -> ShowS
CharacterLen -> String
(Kind -> CharacterLen -> ShowS)
-> (CharacterLen -> String)
-> ([CharacterLen] -> ShowS)
-> Show CharacterLen
forall a.
(Kind -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharacterLen] -> ShowS
$cshowList :: [CharacterLen] -> ShowS
show :: CharacterLen -> String
$cshow :: CharacterLen -> String
showsPrec :: Kind -> CharacterLen -> ShowS
$cshowsPrec :: Kind -> CharacterLen -> ShowS
Show, Typeable CharacterLen
Typeable CharacterLen
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CharacterLen -> c CharacterLen)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CharacterLen)
-> (CharacterLen -> Constr)
-> (CharacterLen -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CharacterLen))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CharacterLen))
-> ((forall b. Data b => b -> b) -> CharacterLen -> CharacterLen)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CharacterLen -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CharacterLen -> r)
-> (forall u. (forall d. Data d => d -> u) -> CharacterLen -> [u])
-> (forall u.
Kind -> (forall d. Data d => d -> u) -> CharacterLen -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CharacterLen -> m CharacterLen)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CharacterLen -> m CharacterLen)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CharacterLen -> m CharacterLen)
-> Data CharacterLen
CharacterLen -> DataType
CharacterLen -> Constr
(forall b. Data b => b -> b) -> CharacterLen -> CharacterLen
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. Kind -> (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. Kind -> (forall d. Data d => d -> u) -> CharacterLen -> u
forall u. (forall d. Data d => d -> u) -> CharacterLen -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CharacterLen -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CharacterLen -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CharacterLen -> m CharacterLen
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CharacterLen -> m CharacterLen
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CharacterLen
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CharacterLen -> c CharacterLen
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CharacterLen)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CharacterLen)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CharacterLen -> m CharacterLen
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CharacterLen -> m CharacterLen
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CharacterLen -> m CharacterLen
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CharacterLen -> m CharacterLen
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CharacterLen -> m CharacterLen
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CharacterLen -> m CharacterLen
gmapQi :: forall u. Kind -> (forall d. Data d => d -> u) -> CharacterLen -> u
$cgmapQi :: forall u. Kind -> (forall d. Data d => d -> u) -> CharacterLen -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> CharacterLen -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CharacterLen -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CharacterLen -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CharacterLen -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CharacterLen -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CharacterLen -> r
gmapT :: (forall b. Data b => b -> b) -> CharacterLen -> CharacterLen
$cgmapT :: (forall b. Data b => b -> b) -> CharacterLen -> CharacterLen
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CharacterLen)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CharacterLen)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CharacterLen)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CharacterLen)
dataTypeOf :: CharacterLen -> DataType
$cdataTypeOf :: CharacterLen -> DataType
toConstr :: CharacterLen -> Constr
$ctoConstr :: CharacterLen -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CharacterLen
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CharacterLen
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CharacterLen -> c CharacterLen
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CharacterLen -> c CharacterLen
Data, Typeable, (forall x. CharacterLen -> Rep CharacterLen x)
-> (forall x. Rep CharacterLen x -> CharacterLen)
-> Generic CharacterLen
forall x. Rep CharacterLen x -> CharacterLen
forall x. CharacterLen -> Rep CharacterLen x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CharacterLen x -> CharacterLen
$cfrom :: forall x. CharacterLen -> Rep CharacterLen x
Generic)
instance Binary CharacterLen
instance Out CharacterLen
instance NFData CharacterLen
charLenSelector :: Maybe (Selector a) -> (Maybe CharacterLen, Maybe String)
charLenSelector :: forall a. Maybe (Selector a) -> (Maybe CharacterLen, Maybe String)
charLenSelector Maybe (Selector a)
Nothing = (Maybe CharacterLen
forall a. Maybe a
Nothing, Maybe String
forall a. Maybe a
Nothing)
charLenSelector (Just (Selector a
_ SrcSpan
_ Maybe (Expression a)
mlen Maybe (Expression a)
mkind)) = (Maybe CharacterLen
l, Maybe String
k)
where
l :: Maybe CharacterLen
l = Expression a -> CharacterLen
forall a. Expression a -> CharacterLen
charLenSelector' (Expression a -> CharacterLen)
-> Maybe (Expression a) -> Maybe CharacterLen
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Expression a)
mlen
k :: Maybe String
k | Just (ExpValue a
_ SrcSpan
_ (ValInteger String
i Maybe (Expression a)
_)) <- Maybe (Expression a)
mkind = String -> Maybe String
forall a. a -> Maybe a
Just String
i
| Just (ExpValue a
_ SrcSpan
_ (ValVariable String
s)) <- Maybe (Expression a)
mkind = String -> Maybe String
forall a. a -> Maybe a
Just String
s
| Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
charLenSelector' :: Expression a -> CharacterLen
charLenSelector' :: forall a. Expression a -> CharacterLen
charLenSelector' = \case
ExpValue a
_ SrcSpan
_ Value a
ValStar -> CharacterLen
CharLenStar
ExpValue a
_ SrcSpan
_ Value a
ValColon -> CharacterLen
CharLenColon
ExpValue a
_ SrcSpan
_ (ValInteger String
i Maybe (Expression a)
_) -> Kind -> CharacterLen
CharLenInt (String -> Kind
forall a. Read a => String -> a
read String
i)
Expression a
_ -> CharacterLen
CharLenExp
charLenToValue :: CharacterLen -> Maybe (Value a)
charLenToValue :: forall a. CharacterLen -> Maybe (Value a)
charLenToValue = \case
CharacterLen
CharLenStar -> Value a -> Maybe (Value a)
forall a. a -> Maybe a
Just Value a
forall a. Value a
ValStar
CharacterLen
CharLenColon -> Value a -> Maybe (Value a)
forall a. a -> Maybe a
Just Value a
forall a. Value a
ValColon
CharLenInt Kind
i -> Value a -> Maybe (Value a)
forall a. a -> Maybe a
Just (String -> Maybe (Expression a) -> Value a
forall a. String -> Maybe (Expression a) -> Value a
ValInteger (Kind -> String
forall a. Show a => a -> String
show Kind
i) Maybe (Expression a)
forall a. Maybe a
Nothing)
CharacterLen
CharLenExp -> Maybe (Value a)
forall a. Maybe a
Nothing
getTypeKind :: SemType -> Kind
getTypeKind :: SemType -> Kind
getTypeKind = \case
TInteger Kind
k -> Kind
k
TReal Kind
k -> Kind
k
TComplex Kind
k -> Kind
k
TLogical Kind
k -> Kind
k
TByte Kind
k -> Kind
k
TCharacter CharacterLen
_ Kind
k -> Kind
k
TCustom String
_ -> String -> Kind
forall a. HasCallStack => String -> a
error String
"TCustom does not have a kind"
TArray SemType
t Maybe Dimensions
_ -> SemType -> Kind
getTypeKind SemType
t
setTypeKind :: SemType -> Kind -> SemType
setTypeKind :: SemType -> Kind -> SemType
setTypeKind SemType
st Kind
k = case SemType
st of
TInteger Kind
_ -> Kind -> SemType
TInteger Kind
k
TReal Kind
_ -> Kind -> SemType
TReal Kind
k
TComplex Kind
_ -> Kind -> SemType
TComplex Kind
k
TLogical Kind
_ -> Kind -> SemType
TLogical Kind
k
TByte Kind
_ -> Kind -> SemType
TByte Kind
k
TCharacter CharacterLen
charLen Kind
_ -> CharacterLen -> Kind -> SemType
TCharacter CharacterLen
charLen Kind
k
TCustom String
_ -> String -> SemType
forall a. HasCallStack => String -> a
error String
"can't set kind of TCustom"
TArray SemType
_ Maybe Dimensions
_ -> String -> SemType
forall a. HasCallStack => String -> a
error String
"can't set kind of TArray"
charLenConcat :: CharacterLen -> CharacterLen -> CharacterLen
charLenConcat :: CharacterLen -> CharacterLen -> CharacterLen
charLenConcat CharacterLen
l1 CharacterLen
l2 = case (CharacterLen
l1, CharacterLen
l2) of
(CharacterLen
CharLenExp , CharacterLen
_ ) -> CharacterLen
CharLenExp
(CharacterLen
_ , CharacterLen
CharLenExp ) -> CharacterLen
CharLenExp
(CharacterLen
CharLenStar , CharacterLen
_ ) -> CharacterLen
CharLenStar
(CharacterLen
_ , CharacterLen
CharLenStar ) -> CharacterLen
CharLenStar
(CharacterLen
CharLenColon , CharacterLen
_ ) -> CharacterLen
CharLenColon
(CharacterLen
_ , CharacterLen
CharLenColon ) -> CharacterLen
CharLenColon
(CharLenInt Kind
i1 , CharLenInt Kind
i2 ) -> Kind -> CharacterLen
CharLenInt (Kind
i1 Kind -> Kind -> Kind
forall a. Num a => a -> a -> a
+ Kind
i2)
recoverSemTypeTypeSpec :: forall a. a -> SrcSpan
-> FortranVersion -> SemType -> TypeSpec a
recoverSemTypeTypeSpec :: forall a. a -> SrcSpan -> FortranVersion -> SemType -> TypeSpec a
recoverSemTypeTypeSpec a
a SrcSpan
ss FortranVersion
v = \case
TInteger Kind
k -> BaseType -> Kind -> TypeSpec a
wrapBaseAndKind BaseType
TypeInteger Kind
k
TLogical Kind
k -> BaseType -> Kind -> TypeSpec a
wrapBaseAndKind BaseType
TypeLogical Kind
k
TByte Kind
k -> BaseType -> Kind -> TypeSpec a
wrapBaseAndKind BaseType
TypeByte Kind
k
TCustom String
str -> BaseType -> Maybe (Selector a) -> TypeSpec a
ts (String -> BaseType
TypeCustom String
str) Maybe (Selector a)
forall a. Maybe a
Nothing
TArray SemType
st Maybe Dimensions
_ -> a -> SrcSpan -> FortranVersion -> SemType -> TypeSpec a
forall a. a -> SrcSpan -> FortranVersion -> SemType -> TypeSpec a
recoverSemTypeTypeSpec a
a SrcSpan
ss FortranVersion
v SemType
st
TReal Kind
k ->
if Kind
k Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
== Kind
8 Bool -> Bool -> Bool
&& FortranVersion
v FortranVersion -> FortranVersion -> Bool
forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran90
then BaseType -> Maybe (Selector a) -> TypeSpec a
ts BaseType
TypeDoublePrecision Maybe (Selector a)
forall a. Maybe a
Nothing
else BaseType -> Kind -> TypeSpec a
wrapBaseAndKind BaseType
TypeReal Kind
k
TComplex Kind
k ->
if Kind
k Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
== Kind
16 Bool -> Bool -> Bool
&& FortranVersion
v FortranVersion -> FortranVersion -> Bool
forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran90
then BaseType -> Maybe (Selector a) -> TypeSpec a
ts BaseType
TypeDoubleComplex Maybe (Selector a)
forall a. Maybe a
Nothing
else BaseType -> Kind -> TypeSpec a
wrapBaseAndKind BaseType
TypeComplex Kind
k
TCharacter CharacterLen
len Kind
k ->
let sel :: Selector a
sel = a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe (Expression a)
-> Selector a
forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe (Expression a)
-> Selector a
Selector a
a SrcSpan
ss (a -> SrcSpan -> Value a -> Expression a
forall a. a -> SrcSpan -> Value a -> Expression a
ExpValue a
a SrcSpan
ss (Value a -> Expression a)
-> Maybe (Value a) -> Maybe (Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharacterLen -> Maybe (Value a)
forall a. CharacterLen -> Maybe (Value a)
charLenToValue CharacterLen
len) (if Kind
k Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
== Kind
1 then Maybe (Expression a)
forall a. Maybe a
Nothing else Expression a -> Maybe (Expression a)
forall a. a -> Maybe a
Just (Kind -> Expression a
intValExpr Kind
k))
in BaseType -> Maybe (Selector a) -> TypeSpec a
ts BaseType
TypeCharacter (Selector a -> Maybe (Selector a)
forall a. a -> Maybe a
Just Selector a
sel)
where
ts :: BaseType -> Maybe (Selector a) -> TypeSpec a
ts = a -> SrcSpan -> BaseType -> Maybe (Selector a) -> TypeSpec a
forall a.
a -> SrcSpan -> BaseType -> Maybe (Selector a) -> TypeSpec a
TypeSpec a
a SrcSpan
ss
intValExpr :: Int -> Expression a
intValExpr :: Kind -> Expression a
intValExpr Kind
x = a -> SrcSpan -> Value a -> Expression a
forall a. a -> SrcSpan -> Value a -> Expression a
ExpValue a
a SrcSpan
ss (String -> Maybe (Expression a) -> Value a
forall a. String -> Maybe (Expression a) -> Value a
ValInteger (Kind -> String
forall a. Show a => a -> String
show Kind
x) Maybe (Expression a)
forall a. Maybe a
Nothing)
wrapBaseAndKind :: BaseType -> Kind -> TypeSpec a
wrapBaseAndKind :: BaseType -> Kind -> TypeSpec a
wrapBaseAndKind BaseType
bt Kind
k = BaseType -> Maybe (Selector a) -> TypeSpec a
ts BaseType
bt Maybe (Selector a)
sel
where
sel :: Maybe (Selector a)
sel = if Kind
k Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
== BaseType -> Kind
kindOfBaseType BaseType
bt
then Maybe (Selector a)
forall a. Maybe a
Nothing
else Selector a -> Maybe (Selector a)
forall a. a -> Maybe a
Just (Selector a -> Maybe (Selector a))
-> Selector a -> Maybe (Selector a)
forall a b. (a -> b) -> a -> b
$ a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe (Expression a)
-> Selector a
forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe (Expression a)
-> Selector a
Selector a
a SrcSpan
ss Maybe (Expression a)
forall a. Maybe a
Nothing (Expression a -> Maybe (Expression a)
forall a. a -> Maybe a
Just (Kind -> Expression a
intValExpr Kind
k))
kindOfBaseType :: BaseType -> Int
kindOfBaseType :: BaseType -> Kind
kindOfBaseType = \case
BaseType
TypeInteger -> Kind
4
BaseType
TypeReal -> Kind
4
BaseType
TypeDoublePrecision -> Kind
8
BaseType
TypeComplex -> Kind
8
BaseType
TypeDoubleComplex -> Kind
16
BaseType
TypeLogical -> Kind
4
TypeCharacter{} -> Kind
1
BaseType
TypeByte -> Kind
1
TypeCustom{} -> Kind
1
BaseType
ClassStar -> Kind
1
ClassCustom{} -> Kind
1
getTypeSize :: SemType -> Maybe Int
getTypeSize :: SemType -> Maybe Kind
getTypeSize = \case
TInteger Kind
k -> Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
k
TReal Kind
k -> Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
k
TComplex Kind
k -> Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
k
TLogical Kind
k -> Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
k
TByte Kind
k -> Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
k
TArray SemType
ty Maybe Dimensions
_ -> SemType -> Maybe Kind
getTypeSize SemType
ty
TCustom String
_ -> Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
1
TCharacter (CharLenInt Kind
l) Kind
k -> Kind -> Maybe Kind
forall a. a -> Maybe a
Just (Kind
l Kind -> Kind -> Kind
forall a. Num a => a -> a -> a
* Kind
k)
TCharacter CharacterLen
_ Kind
_ -> Maybe Kind
forall a. Maybe a
Nothing
setTypeSize :: SemType -> Maybe Int -> SemType
setTypeSize :: SemType -> Maybe Kind -> SemType
setTypeSize SemType
ty Maybe Kind
mk = case (Maybe Kind
mk, SemType
ty) of
(Just Kind
k, TInteger Kind
_ ) -> Kind -> SemType
TInteger Kind
k
(Just Kind
k, TReal Kind
_ ) -> Kind -> SemType
TReal Kind
k
(Just Kind
k, TComplex Kind
_ ) -> Kind -> SemType
TComplex Kind
k
(Just Kind
k, TLogical Kind
_ ) -> Kind -> SemType
TLogical Kind
k
(Just Kind
k, TByte Kind
_ ) -> Kind -> SemType
TByte Kind
k
(Maybe Kind
_ , TCustom String
s ) -> String -> SemType
TCustom String
s
(Just Kind
l, TCharacter CharacterLen
_ Kind
k) ->
CharacterLen -> Kind -> SemType
TCharacter (Kind -> CharacterLen
CharLenInt Kind
l) Kind
k
(Maybe Kind
Nothing, TCharacter CharacterLen
_ Kind
k) ->
CharacterLen -> Kind -> SemType
TCharacter CharacterLen
CharLenStar Kind
k
(Maybe Kind, SemType)
_ -> String -> SemType
forall a. HasCallStack => String -> a
error (String -> SemType) -> String -> SemType
forall a b. (a -> b) -> a -> b
$ String
"Tried to set invalid kind for type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SemType -> String
forall a. Show a => a -> String
show SemType
ty