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
                                                )

-- | Given dimenion declarators and the typespec, give ArrayTypeData evaluating
-- valid expressions for the upper and lower bound
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"

-- | Given the typespec of a scalar get the StaticType
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