module Language.Fortran.Vars.Utils where
import Language.Fortran.Analysis ( Analysis )
import Language.Fortran.AST
import Language.Fortran.Vars.Types ( SymbolTable
, ExpVal(..)
, Type
, SemType(..)
, Dim(..)
, Dims(..)
, Dimensions
)
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 =
case forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DimensionDeclarator (Analysis a)
-> [Dim (Maybe Int)] -> [Dim (Maybe Int)]
go [] [DimensionDeclarator (Analysis a)]
dims of
[] -> forall a. HasCallStack => [Char] -> a
error [Char]
"invalid array spec: zero dimensions"
Dim (Maybe Int)
d:[Dim (Maybe Int)]
ds -> Type -> Dimensions -> Type
TArray Type
scalarTy forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. t (Dim a) -> Dims t a
DimsExplicitShape forall a b. (a -> b) -> a -> b
$ Dim (Maybe Int)
d forall a. a -> [a] -> NonEmpty a
:| [Dim (Maybe Int)]
ds
where
scalarTy :: Type
scalarTy = forall a. SymbolTable -> TypeSpec (Analysis a) -> Type
typeSpecToScalarType SymbolTable
st TypeSpec (Analysis a)
tySpec
go :: DimensionDeclarator (Analysis a)
-> [Dim (Maybe Int)] -> [Dim (Maybe Int)]
go (DimensionDeclarator Analysis a
_ SrcSpan
_ (Just Expression (Analysis a)
lb) (Just Expression (Analysis a)
ub)) [Dim (Maybe Int)]
dims =
forall a. a -> a -> Dim a
Dim (forall a. a -> Maybe a
Just (Expression (Analysis a) -> Int
constInt Expression (Analysis a)
lb)) (forall a. a -> Maybe a
Just (Expression (Analysis a) -> Int
constInt Expression (Analysis a)
ub)) forall a. a -> [a] -> [a]
: [Dim (Maybe Int)]
dims
go (DimensionDeclarator Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
Nothing (Just Expression (Analysis a)
ub)) [Dim (Maybe Int)]
dims =
forall a. a -> a -> Dim a
Dim (forall a. a -> Maybe a
Just Int
1) (forall a. a -> Maybe a
Just (Expression (Analysis a) -> Int
constInt Expression (Analysis a)
ub)) forall a. a -> [a] -> [a]
: [Dim (Maybe Int)]
dims
go DimensionDeclarator (Analysis a)
_ [Dim (Maybe Int)]
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid dimension declarator"
constInt :: Expression (Analysis a) -> Int
constInt Expression (Analysis a)
x = case forall a. SymbolTable -> Expression a -> ExpVal
eval SymbolTable
st Expression (Analysis a)
x of
Int Int
y -> Int
y
ExpVal
_ -> 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
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
constInt Expression (Analysis a)
l)
Maybe (Selector (Analysis a))
Nothing -> Type -> Maybe Int -> Type
setTypeKind Type
ty' (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ BaseType -> Int
kindOfBaseType BaseType
ty)
Maybe (Selector (Analysis a))
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid type spec"
where
constInt :: Expression (Analysis a) -> Maybe Int
constInt Expression (Analysis a)
x = case forall a. SymbolTable -> Expression a -> Either [Char] ExpVal
eval' SymbolTable
st Expression (Analysis a)
x of
Right (Int Int
y) -> forall a. a -> Maybe a
Just Int
y
Either [Char] ExpVal
_ -> forall a. Maybe a
Nothing