{-# LANGUAGE LambdaCase #-}
module Language.Fortran.Vars.Kind
( module Language.Fortran.Vars.Kind
, kindOfBaseType
, getTypeSize
, setTypeSize
, deriveSemTypeFromBaseType
)
where
import Data.Maybe ( fromJust )
import Language.Fortran.Analysis ( Analysis )
import Language.Fortran.Analysis.Types
( deriveSemTypeFromBaseType )
import Language.Fortran.AST ( BaseType(..)
, Expression(..)
, Selector(..)
, TypeSpec(..)
, Value(..)
)
import Language.Fortran.Analysis.SemanticTypes
( kindOfBaseType
, getTypeSize
, setTypeSize
)
import Language.Fortran.Vars.Errors ( invalidArg )
import Language.Fortran.Vars.Eval ( eval' )
import Language.Fortran.Vars.Types ( ExpVal(..)
, Type
, SemType(..)
, CharacterLen(..)
, SymbolTable
)
baseToType :: BaseType -> Type
baseToType :: BaseType -> Type
baseToType = BaseType -> Type
deriveSemTypeFromBaseType
getTypeKind :: Type -> Maybe Int
getTypeKind :: Type -> Maybe Int
getTypeKind = Type -> Maybe Int
getTypeSize
setTypeKind :: Type -> Maybe Int -> Type
setTypeKind :: Type -> Maybe Int -> Type
setTypeKind = Type -> Maybe Int -> Type
setTypeSize
typeOfExpVal :: ExpVal -> Type
typeOfExpVal :: ExpVal -> Type
typeOfExpVal = \case
Int Int
_ -> Int -> Type
TInteger Int
4
Real Double
_ -> Int -> Type
TReal Int
4
Logical Bool
_ -> Int -> Type
TLogical Int
4
Str String
_ -> CharacterLen -> Int -> Type
TCharacter (Int -> CharacterLen
CharLenInt Int
1) Int
1
Boz Boz
_ -> forall a. HasCallStack => String -> a
error String
"BOZ constant is type-less"
isStr :: ExpVal -> Bool
isStr :: ExpVal -> Bool
isStr ExpVal
e = case ExpVal
e of
Str String
_ -> Bool
True
ExpVal
_ -> Bool
False
getKindOfExpVal :: ExpVal -> Int
getKindOfExpVal :: ExpVal -> Int
getKindOfExpVal (Str String
s) = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
getKindOfExpVal ExpVal
ev = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Maybe Int
getTypeSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpVal -> Type
typeOfExpVal forall a b. (a -> b) -> a -> b
$ ExpVal
ev
toInt :: ExpVal -> Int
toInt :: ExpVal -> Int
toInt (Int Int
i) = Int
i
toInt ExpVal
e = forall a b. Show a => String -> [a] -> b
invalidArg String
"toInt" [ExpVal
e]
getKind
:: SymbolTable
-> TypeSpec (Analysis a)
-> Maybe (Expression (Analysis a))
-> Maybe Int
getKind :: forall a.
SymbolTable
-> TypeSpec (Analysis a)
-> Maybe (Expression (Analysis a))
-> Maybe Int
getKind SymbolTable
symTable (TypeSpec Analysis a
_ SrcSpan
_ BaseType
bt Maybe (Selector (Analysis a))
selector) Maybe (Expression (Analysis a))
charLength =
let evalMaybeKind :: Expression (Analysis a) -> Maybe Int
evalMaybeKind Expression (Analysis a)
kind =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpVal -> Int
toInt) forall a b. (a -> b) -> a -> b
$ forall a. SymbolTable -> Expression a -> Either String ExpVal
eval' SymbolTable
symTable Expression (Analysis a)
kind
in case Maybe (Expression (Analysis a))
charLength of
Just Expression (Analysis a)
charLen -> Expression (Analysis a) -> Maybe Int
evalMaybeKind Expression (Analysis a)
charLen
Maybe (Expression (Analysis a))
Nothing -> case Maybe (Selector (Analysis a))
selector of
Just (Selector Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ (Just Expression (Analysis a)
kindExp)) ->
let k' :: Expression (Analysis a)
k' = Expression (Analysis a)
kindExp
in case Expression (Analysis a)
k' of
ExpValue Analysis a
_ SrcSpan
_ Value (Analysis a)
ValStar -> forall a. Maybe a
Nothing
Expression (Analysis a)
_ -> Expression (Analysis a) -> Maybe Int
evalMaybeKind Expression (Analysis a)
kindExp
Just (Selector Analysis a
_ SrcSpan
_ (Just Expression (Analysis a)
lengthExp) Maybe (Expression (Analysis a))
_) ->
let l' :: Expression (Analysis a)
l' = Expression (Analysis a)
lengthExp
in case Expression (Analysis a)
l' of
ExpValue Analysis a
_ SrcSpan
_ Value (Analysis a)
ValStar -> forall a. Maybe a
Nothing
Expression (Analysis a)
_ -> Expression (Analysis a) -> Maybe Int
evalMaybeKind Expression (Analysis a)
lengthExp
Maybe (Selector (Analysis a))
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ BaseType -> Int
kindOfBaseType BaseType
bt