module Language.Fortran.Vars.Utils where
import Language.Fortran.Analysis ( Analysis )
import Language.Fortran.AST
import Language.Fortran.Vars.Types
( SymbolTable
, ExpVal(..)
, Type(..)
, SemType(..)
)
import Language.Fortran.Vars.Eval
( eval
, eval'
)
import Language.Fortran.Vars.Kind
( setTypeKind
, kindOfBaseType
, baseToType
)
typeSpecToArrayType
:: SymbolTable
-> [DimensionDeclarator (Analysis a)]
-> TypeSpec (Analysis a)
-> Type
typeSpecToArrayType :: forall a.
SymbolTable
-> [DimensionDeclarator (Analysis a)]
-> TypeSpec (Analysis a)
-> Type
typeSpecToArrayType SymbolTable
st [DimensionDeclarator (Analysis a)]
dims TypeSpec (Analysis a)
tySpec = Type -> Maybe Dimensions -> Type
TArray Type
scalarTy (Maybe Dimensions -> Type) -> Maybe Dimensions -> Type
forall a b. (a -> b) -> a -> b
$ Dimensions -> Maybe Dimensions
forall a. a -> Maybe a
Just (Dimensions -> Maybe Dimensions) -> Dimensions -> Maybe Dimensions
forall a b. (a -> b) -> a -> b
$ (DimensionDeclarator (Analysis a) -> (Int, Int))
-> [DimensionDeclarator (Analysis a)] -> Dimensions
forall a b. (a -> b) -> [a] -> [b]
map DimensionDeclarator (Analysis a) -> (Int, Int)
forall {a}. DimensionDeclarator a -> (Int, Int)
dimStrip [DimensionDeclarator (Analysis a)]
dims
where
scalarTy :: Type
scalarTy = SymbolTable -> TypeSpec (Analysis a) -> Type
forall a. SymbolTable -> TypeSpec (Analysis a) -> Type
typeSpecToScalarType SymbolTable
st TypeSpec (Analysis a)
tySpec
dimStrip :: DimensionDeclarator a -> (Int, Int)
dimStrip (DimensionDeclarator a
_ SrcSpan
_ (Just Expression a
lb) (Just Expression a
ub)) =
(Expression a -> Int
forall {a}. Expression a -> Int
constInt Expression a
lb, Expression a -> Int
forall {a}. Expression a -> Int
constInt Expression a
ub)
dimStrip (DimensionDeclarator a
_ SrcSpan
_ Maybe (Expression a)
Nothing (Just Expression a
ub)) = (Int
1, Expression a -> Int
forall {a}. Expression a -> Int
constInt Expression a
ub)
dimStrip DimensionDeclarator a
_ = [Char] -> (Int, Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid dimension declarator"
constInt :: Expression a -> Int
constInt Expression a
x = case SymbolTable -> Expression a -> ExpVal
forall a. SymbolTable -> Expression a -> ExpVal
eval SymbolTable
st Expression a
x of
Int Int
y -> Int
y
ExpVal
_ -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid array spec"
typeSpecToScalarType :: SymbolTable -> TypeSpec (Analysis a) -> Type
typeSpecToScalarType :: forall a. SymbolTable -> TypeSpec (Analysis a) -> Type
typeSpecToScalarType SymbolTable
st (TypeSpec Analysis a
_ SrcSpan
_ BaseType
ty Maybe (Selector (Analysis a))
selector) =
let ty' :: Type
ty' = BaseType -> Type
baseToType BaseType
ty
in case Maybe (Selector (Analysis a))
selector of
Just (Selector Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ (Just Expression (Analysis a)
k)) -> Type -> Maybe Int -> Type
setTypeKind Type
ty' (Expression (Analysis a) -> Maybe Int
forall {a}. Expression a -> Maybe Int
constInt Expression (Analysis a)
k)
Just (Selector Analysis a
_ SrcSpan
_ (Just Expression (Analysis a)
l) Maybe (Expression (Analysis a))
_ ) -> Type -> Maybe Int -> Type
setTypeKind Type
ty' (Expression (Analysis a) -> Maybe Int
forall {a}. Expression a -> Maybe Int
constInt Expression (Analysis a)
l)
Maybe (Selector (Analysis a))
Nothing -> Type -> Maybe Int -> Type
setTypeKind Type
ty' (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ BaseType -> Int
kindOfBaseType BaseType
ty)
Maybe (Selector (Analysis a))
_ -> [Char] -> Type
forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid type spec"
where
constInt :: Expression a -> Maybe Int
constInt Expression a
x = case SymbolTable -> Expression a -> Either [Char] ExpVal
forall a. SymbolTable -> Expression a -> Either [Char] ExpVal
eval' SymbolTable
st Expression a
x of
Right (Int Int
y) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
y
Either [Char] ExpVal
_ -> Maybe Int
forall a. Maybe a
Nothing