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
                                                )

-- | 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 st dims tySpec = TArray scalarTy $ foldr go DimensionsEnd dims
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"

-- | 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
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