{-# LANGUAGE ScopedTypeVariables #-}
module Language.Fortran.Analysis.Types
  ( analyseTypes, analyseTypesWithEnv, analyseAndCheckTypesWithEnv, extractTypeEnv, TypeEnv, TypeError )
where

import Language.Fortran.AST

import Prelude hiding (lookup, EQ, LT, GT)
import Data.Map (insert)
import qualified Data.Map as M
import Data.Maybe (maybeToList)
import Data.List (find)
import Control.Monad.State.Strict
import Data.Generics.Uniplate.Data
import Data.Data
import Data.Functor.Identity (Identity ())
import Language.Fortran.Analysis
import Language.Fortran.Intrinsics
import Language.Fortran.Util.Position
import Language.Fortran.ParserMonad (FortranVersion(..))


--------------------------------------------------

-- | Mapping of names to type information.
type TypeEnv = M.Map Name IDType

-- | Information about a detected type error.
type TypeError = (String, SrcSpan)

--------------------------------------------------

-- Monad for type inference work
type Infer a = State InferState a
data InferState = InferState { InferState -> FortranVersion
langVersion :: FortranVersion
                             , InferState -> IntrinsicsTable
intrinsics  :: IntrinsicsTable
                             , InferState -> TypeEnv
environ     :: TypeEnv
                             , InferState -> Map Name (Name, Maybe Name)
entryPoints :: M.Map Name (Name, Maybe Name)
                             , InferState -> [TypeError]
typeErrors  :: [TypeError] }
  deriving Int -> InferState -> ShowS
[InferState] -> ShowS
InferState -> Name
(Int -> InferState -> ShowS)
-> (InferState -> Name)
-> ([InferState] -> ShowS)
-> Show InferState
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [InferState] -> ShowS
$cshowList :: [InferState] -> ShowS
show :: InferState -> Name
$cshow :: InferState -> Name
showsPrec :: Int -> InferState -> ShowS
$cshowsPrec :: Int -> InferState -> ShowS
Show
type InferFunc t = t -> Infer ()

--------------------------------------------------

-- | Annotate AST nodes with type information and also return a type
-- environment mapping names to type information.
analyseTypes :: Data a => ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv)
analyseTypes :: ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv)
analyseTypes = TypeEnv
-> ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv)
forall a.
Data a =>
TypeEnv
-> ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv)
analyseTypesWithEnv TypeEnv
forall k a. Map k a
M.empty

-- | Annotate AST nodes with type information and also return a type
-- environment mapping names to type information; provided with a
-- starting type environment.
analyseTypesWithEnv :: Data a => TypeEnv -> ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv)
analyseTypesWithEnv :: TypeEnv
-> ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv)
analyseTypesWithEnv TypeEnv
env ProgramFile (Analysis a)
pf = (ProgramFile (Analysis a)
pf', TypeEnv
tenv)
  where
    (ProgramFile (Analysis a)
pf', InferState
endState) = TypeEnv
-> ProgramFile (Analysis a)
-> (ProgramFile (Analysis a), InferState)
forall a.
Data a =>
TypeEnv
-> ProgramFile (Analysis a)
-> (ProgramFile (Analysis a), InferState)
analyseTypesWithEnv' TypeEnv
env ProgramFile (Analysis a)
pf
    tenv :: TypeEnv
tenv            = InferState -> TypeEnv
environ InferState
endState

-- | Annotate AST nodes with type information, return a type
-- environment mapping names to type information and return any type
-- errors found; provided with a starting type environment.
analyseAndCheckTypesWithEnv
  :: Data a => TypeEnv -> ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv, [TypeError])
analyseAndCheckTypesWithEnv :: TypeEnv
-> ProgramFile (Analysis a)
-> (ProgramFile (Analysis a), TypeEnv, [TypeError])
analyseAndCheckTypesWithEnv TypeEnv
env ProgramFile (Analysis a)
pf = (ProgramFile (Analysis a)
pf', TypeEnv
tenv, [TypeError]
terrs)
  where
    (ProgramFile (Analysis a)
pf', InferState
endState) = TypeEnv
-> ProgramFile (Analysis a)
-> (ProgramFile (Analysis a), InferState)
forall a.
Data a =>
TypeEnv
-> ProgramFile (Analysis a)
-> (ProgramFile (Analysis a), InferState)
analyseTypesWithEnv' TypeEnv
env ProgramFile (Analysis a)
pf
    tenv :: TypeEnv
tenv            = InferState -> TypeEnv
environ InferState
endState
    terrs :: [TypeError]
terrs           = InferState -> [TypeError]
typeErrors InferState
endState

analyseTypesWithEnv' :: Data a => TypeEnv -> ProgramFile (Analysis a) -> (ProgramFile (Analysis a), InferState)
analyseTypesWithEnv' :: TypeEnv
-> ProgramFile (Analysis a)
-> (ProgramFile (Analysis a), InferState)
analyseTypesWithEnv' TypeEnv
env pf :: ProgramFile (Analysis a)
pf@(ProgramFile MetaInfo
mi [ProgramUnit (Analysis a)]
_) = FortranVersion
-> TypeEnv
-> State InferState (ProgramFile (Analysis a))
-> (ProgramFile (Analysis a), InferState)
forall a.
FortranVersion -> TypeEnv -> State InferState a -> (a, InferState)
runInfer (MetaInfo -> FortranVersion
miVersion MetaInfo
mi) TypeEnv
env (State InferState (ProgramFile (Analysis a))
 -> (ProgramFile (Analysis a), InferState))
-> State InferState (ProgramFile (Analysis a))
-> (ProgramFile (Analysis a), InferState)
forall a b. (a -> b) -> a -> b
$ do
  -- Gather information.
  (Expression (Analysis a) -> StateT InferState Identity ())
-> [Expression (Analysis a)] -> StateT InferState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Expression (Analysis a) -> StateT InferState Identity ()
forall a. Data a => InferFunc (Expression (Analysis a))
intrinsicsExp (UniFunc ProgramFile Expression a
forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
UniFunc f Expression a
allExpressions ProgramFile (Analysis a)
pf)
  (ProgramUnit (Analysis a) -> StateT InferState Identity ())
-> [ProgramUnit (Analysis a)] -> StateT InferState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ProgramUnit (Analysis a) -> StateT InferState Identity ()
forall a. Data a => InferFunc (ProgramUnit (Analysis a))
programUnit (UniFunc ProgramFile ProgramUnit a
forall a. Data a => UniFunc ProgramFile ProgramUnit a
allProgramUnits ProgramFile (Analysis a)
pf)
  (Declarator (Analysis a) -> StateT InferState Identity ())
-> [Declarator (Analysis a)] -> StateT InferState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Declarator (Analysis a) -> StateT InferState Identity ()
forall a. Data a => InferFunc (Declarator (Analysis a))
declarator (UniFunc ProgramFile Declarator a
forall a. Data a => UniFunc ProgramFile Declarator a
allDeclarators ProgramFile (Analysis a)
pf)
  (Statement (Analysis a) -> StateT InferState Identity ())
-> [Statement (Analysis a)] -> StateT InferState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Statement (Analysis a) -> StateT InferState Identity ()
forall a. Data a => InferFunc (Statement (Analysis a))
statement (UniFunc ProgramFile Statement a
forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
UniFunc f Statement a
allStatements ProgramFile (Analysis a)
pf)

  -- Gather types for known entry points.
  [(Name, (Name, Maybe Name))]
eps <- (InferState -> [(Name, (Name, Maybe Name))])
-> StateT InferState Identity [(Name, (Name, Maybe Name))]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Map Name (Name, Maybe Name) -> [(Name, (Name, Maybe Name))]
forall k a. Map k a -> [(k, a)]
M.toList (Map Name (Name, Maybe Name) -> [(Name, (Name, Maybe Name))])
-> (InferState -> Map Name (Name, Maybe Name))
-> InferState
-> [(Name, (Name, Maybe Name))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InferState -> Map Name (Name, Maybe Name)
entryPoints)
  [()]
_ <- [(Name, (Name, Maybe Name))]
-> ((Name, (Name, Maybe Name)) -> StateT InferState Identity ())
-> StateT InferState Identity [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Name, (Name, Maybe Name))]
eps (((Name, (Name, Maybe Name)) -> StateT InferState Identity ())
 -> StateT InferState Identity [()])
-> ((Name, (Name, Maybe Name)) -> StateT InferState Identity ())
-> StateT InferState Identity [()]
forall a b. (a -> b) -> a -> b
$ \ (Name
eName, (Name
fName, Maybe Name
mRetName)) -> do
    Maybe IDType
mFType <- Name -> Infer (Maybe IDType)
getRecordedType Name
fName
    case Maybe IDType
mFType of
      Just (IDType Maybe BaseType
fVType Maybe ConstructType
fCType) -> do
        Maybe BaseType
-> Maybe ConstructType -> Name -> StateT InferState Identity ()
recordMType Maybe BaseType
fVType Maybe ConstructType
fCType Name
eName
        -- FIXME: what about functions that return arrays?
        StateT InferState Identity ()
-> (Name -> StateT InferState Identity ())
-> Maybe Name
-> StateT InferState Identity ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> StateT InferState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Name -> Name -> Any
forall a. HasCallStack => Name -> a
error Name
"Entry points with result variables unsupported" (Name -> Any)
-> (Name -> StateT InferState Identity ())
-> Name
-> StateT InferState Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe BaseType
-> Maybe ConstructType -> Name -> StateT InferState Identity ()
recordMType Maybe BaseType
fVType Maybe ConstructType
forall a. Maybe a
Nothing) Maybe Name
mRetName
      Maybe IDType
_                           -> () -> StateT InferState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  ProgramFile (Analysis a)
-> State InferState (ProgramFile (Analysis a))
forall a.
Data a =>
ProgramFile (Analysis a) -> Infer (ProgramFile (Analysis a))
annotateTypes ProgramFile (Analysis a)
pf              -- Annotate AST nodes with their types.

extractTypeEnv :: forall a. Data a => ProgramFile (Analysis a) -> TypeEnv
extractTypeEnv :: ProgramFile (Analysis a) -> TypeEnv
extractTypeEnv ProgramFile (Analysis a)
pf = TypeEnv -> TypeEnv -> TypeEnv
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union TypeEnv
puEnv TypeEnv
expEnv
  where
    puEnv :: TypeEnv
puEnv = [(Name, IDType)] -> TypeEnv
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Name
n, IDType
ty) | ProgramUnit (Analysis a)
pu <- ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile (Analysis a)
pf :: [ProgramUnit (Analysis a)]
                                 , Named Name
n <- [ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
puName ProgramUnit (Analysis a)
pu]
                                 , IDType
ty <- Maybe IDType -> [IDType]
forall a. Maybe a -> [a]
maybeToList (Analysis a -> Maybe IDType
forall a. Analysis a -> Maybe IDType
idType (ProgramUnit (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation ProgramUnit (Analysis a)
pu)) ]
    expEnv :: TypeEnv
expEnv = [(Name, IDType)] -> TypeEnv
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Name
n, IDType
ty) | e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ ValVariable{}) <- ProgramFile (Analysis a) -> [Expression (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile (Analysis a)
pf :: [Expression (Analysis a)]
                                  , let n :: Name
n = Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
e
                                  , IDType
ty <- Maybe IDType -> [IDType]
forall a. Maybe a -> [a]
maybeToList (Analysis a -> Maybe IDType
forall a. Analysis a -> Maybe IDType
idType (Expression (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation Expression (Analysis a)
e)) ]

type TransType f g a = (f (Analysis a) -> Infer (f (Analysis a))) -> g (Analysis a) -> Infer (g (Analysis a))
annotateTypes :: Data a => ProgramFile (Analysis a) -> Infer (ProgramFile (Analysis a))
annotateTypes :: ProgramFile (Analysis a) -> Infer (ProgramFile (Analysis a))
annotateTypes ProgramFile (Analysis a)
pf = (forall a.
Data a =>
(Expression (Analysis a)
 -> StateT InferState Identity (Expression (Analysis a)))
-> ProgramFile (Analysis a)
-> StateT InferState Identity (ProgramFile (Analysis a))
forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM :: Data a => TransType Expression ProgramFile a) Expression (Analysis a)
-> StateT InferState Identity (Expression (Analysis a))
forall a.
Data a =>
Expression (Analysis a) -> Infer (Expression (Analysis a))
annotateExpression ProgramFile (Analysis a)
pf Infer (ProgramFile (Analysis a))
-> (ProgramFile (Analysis a) -> Infer (ProgramFile (Analysis a)))
-> Infer (ProgramFile (Analysis a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                   (forall a.
Data a =>
(ProgramUnit (Analysis a)
 -> StateT InferState Identity (ProgramUnit (Analysis a)))
-> ProgramFile (Analysis a)
-> StateT InferState Identity (ProgramFile (Analysis a))
forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM :: Data a => TransType ProgramUnit ProgramFile a) ProgramUnit (Analysis a)
-> StateT InferState Identity (ProgramUnit (Analysis a))
forall a.
Data a =>
ProgramUnit (Analysis a) -> Infer (ProgramUnit (Analysis a))
annotateProgramUnit

intrinsicsExp :: Data a => InferFunc (Expression (Analysis a))
intrinsicsExp :: InferFunc (Expression (Analysis a))
intrinsicsExp (ExpSubscript Analysis a
_ SrcSpan
_ Expression (Analysis a)
nexp AList Index (Analysis a)
_)    = InferFunc (Expression (Analysis a))
forall a. Expression (Analysis a) -> StateT InferState Identity ()
intrinsicsHelper Expression (Analysis a)
nexp
intrinsicsExp (ExpFunctionCall Analysis a
_ SrcSpan
_ Expression (Analysis a)
nexp Maybe (AList Argument (Analysis a))
_) = InferFunc (Expression (Analysis a))
forall a. Expression (Analysis a) -> StateT InferState Identity ()
intrinsicsHelper Expression (Analysis a)
nexp
intrinsicsExp Expression (Analysis a)
_                            = () -> StateT InferState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

intrinsicsHelper :: Expression (Analysis a) -> StateT InferState Identity ()
intrinsicsHelper :: Expression (Analysis a) -> StateT InferState Identity ()
intrinsicsHelper Expression (Analysis a)
nexp | Expression (Analysis a) -> Bool
forall a. Expression a -> Bool
isNamedExpression Expression (Analysis a)
nexp = do
  IntrinsicsTable
itab <- (InferState -> IntrinsicsTable)
-> StateT InferState Identity IntrinsicsTable
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InferState -> IntrinsicsTable
intrinsics
  case Name -> IntrinsicsTable -> Maybe IntrinsicType
getIntrinsicReturnType (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
srcName Expression (Analysis a)
nexp) IntrinsicsTable
itab of
    Just IntrinsicType
_ -> do
      let n :: Name
n = Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
nexp
      ConstructType -> Name -> StateT InferState Identity ()
recordCType ConstructType
CTIntrinsic Name
n
      -- recordBaseType _  n -- FIXME: going to skip base types for the moment
    Maybe IntrinsicType
_             -> () -> StateT InferState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
intrinsicsHelper Expression (Analysis a)
_ = () -> StateT InferState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

programUnit :: Data a => InferFunc (ProgramUnit (Analysis a))
programUnit :: InferFunc (ProgramUnit (Analysis a))
programUnit pu :: ProgramUnit (Analysis a)
pu@(PUFunction Analysis a
_ SrcSpan
_ Maybe (TypeSpec (Analysis a))
mRetType PrefixSuffix (Analysis a)
_ Name
_ Maybe (AList Expression (Analysis a))
_ Maybe (Expression (Analysis a))
mRetVar [Block (Analysis a)]
blocks Maybe [ProgramUnit (Analysis a)]
_)
  | Named Name
n <- ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
puName ProgramUnit (Analysis a)
pu   = do
    -- record some type information that we can glean
    ConstructType -> Name -> StateT InferState Identity ()
recordCType ConstructType
CTFunction Name
n
    case (Maybe (TypeSpec (Analysis a))
mRetType, Maybe (Expression (Analysis a))
mRetVar) of
      (Just (TypeSpec Analysis a
_ SrcSpan
_ BaseType
baseType Maybe (Selector (Analysis a))
_), Just Expression (Analysis a)
v) -> BaseType -> Name -> StateT InferState Identity ()
recordBaseType BaseType
baseType Name
n StateT InferState Identity ()
-> StateT InferState Identity () -> StateT InferState Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BaseType -> Name -> StateT InferState Identity ()
recordBaseType BaseType
baseType (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v)
      (Just (TypeSpec Analysis a
_ SrcSpan
_ BaseType
baseType Maybe (Selector (Analysis a))
_), Maybe (Expression (Analysis a))
_)      -> BaseType -> Name -> StateT InferState Identity ()
recordBaseType BaseType
baseType Name
n
      (Maybe (TypeSpec (Analysis a)), Maybe (Expression (Analysis a)))
_                                        -> () -> StateT InferState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    -- record entry points for later annotation
    [Block (Analysis a)]
-> (Block (Analysis a) -> StateT InferState Identity ())
-> StateT InferState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Block (Analysis a)]
blocks ((Block (Analysis a) -> StateT InferState Identity ())
 -> StateT InferState Identity ())
-> (Block (Analysis a) -> StateT InferState Identity ())
-> StateT InferState Identity ()
forall a b. (a -> b) -> a -> b
$ \ Block (Analysis a)
block ->
      [StateT InferState Identity ()] -> StateT InferState Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ Name -> Name -> Maybe Name -> StateT InferState Identity ()
recordEntryPoint Name
n (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v) ((Expression (Analysis a) -> Name)
-> Maybe (Expression (Analysis a)) -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Maybe (Expression (Analysis a))
mRetVar') | (StEntry Analysis a
_ SrcSpan
_ Expression (Analysis a)
v Maybe (AList Expression (Analysis a))
_ Maybe (Expression (Analysis a))
mRetVar') <- UniFunc Block Statement a
forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
UniFunc f Statement a
allStatements Block (Analysis a)
block ]
programUnit pu :: ProgramUnit (Analysis a)
pu@(PUSubroutine Analysis a
_ SrcSpan
_ PrefixSuffix (Analysis a)
_ Name
_ Maybe (AList Expression (Analysis a))
_ [Block (Analysis a)]
blocks Maybe [ProgramUnit (Analysis a)]
_) | Named Name
n <- ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
puName ProgramUnit (Analysis a)
pu = do
  -- record the fact that this is a subroutine
  ConstructType -> Name -> StateT InferState Identity ()
recordCType ConstructType
CTSubroutine Name
n
  -- record entry points for later annotation
  [Block (Analysis a)]
-> (Block (Analysis a) -> StateT InferState Identity ())
-> StateT InferState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Block (Analysis a)]
blocks ((Block (Analysis a) -> StateT InferState Identity ())
 -> StateT InferState Identity ())
-> (Block (Analysis a) -> StateT InferState Identity ())
-> StateT InferState Identity ()
forall a b. (a -> b) -> a -> b
$ \ Block (Analysis a)
block ->
    [StateT InferState Identity ()] -> StateT InferState Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ Name -> Name -> Maybe Name -> StateT InferState Identity ()
recordEntryPoint Name
n (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v) Maybe Name
forall a. Maybe a
Nothing | (StEntry Analysis a
_ SrcSpan
_ Expression (Analysis a)
v Maybe (AList Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_) <- UniFunc Block Statement a
forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
UniFunc f Statement a
allStatements Block (Analysis a)
block ]
programUnit ProgramUnit (Analysis a)
_                                           = () -> StateT InferState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

declarator :: Data a => InferFunc (Declarator (Analysis a))
declarator :: InferFunc (Declarator (Analysis a))
declarator (DeclArray Analysis a
_ SrcSpan
_ Expression (Analysis a)
v AList DimensionDeclarator (Analysis a)
ddAList Maybe (Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_) = ConstructType -> Name -> StateT InferState Identity ()
recordCType ([(Maybe Int, Maybe Int)] -> ConstructType
CTArray ([(Maybe Int, Maybe Int)] -> ConstructType)
-> [(Maybe Int, Maybe Int)] -> ConstructType
forall a b. (a -> b) -> a -> b
$ AList DimensionDeclarator (Analysis a) -> [(Maybe Int, Maybe Int)]
forall a. AList DimensionDeclarator a -> [(Maybe Int, Maybe Int)]
dimDeclarator AList DimensionDeclarator (Analysis a)
ddAList) (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v)
declarator Declarator (Analysis a)
_ = () -> StateT InferState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

dimDeclarator :: AList DimensionDeclarator a -> [(Maybe Int, Maybe Int)]
dimDeclarator :: AList DimensionDeclarator a -> [(Maybe Int, Maybe Int)]
dimDeclarator AList DimensionDeclarator a
ddAList = [ (Maybe Int
lb, Maybe Int
ub) | DimensionDeclarator a
_ SrcSpan
_ Maybe (Expression a)
lbExp Maybe (Expression a)
ubExp <- AList DimensionDeclarator a -> [DimensionDeclarator a]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList DimensionDeclarator a
ddAList
                                   , let lb :: Maybe Int
lb = do ExpValue a
_ SrcSpan
_ (ValInteger Name
i) <- Maybe (Expression a)
lbExp
                                                 Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Name -> Int
forall a. Read a => Name -> a
read Name
i
                                   , let ub :: Maybe Int
ub = do ExpValue a
_ SrcSpan
_ (ValInteger Name
i) <- Maybe (Expression a)
ubExp
                                                 Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Name -> Int
forall a. Read a => Name -> a
read Name
i ]

statement :: Data a => InferFunc (Statement (Analysis a))
-- maybe FIXME: should Kind Selectors be part of types?
statement :: InferFunc (Statement (Analysis a))
statement (StDeclaration Analysis a
_ SrcSpan
_ (TypeSpec Analysis a
_ SrcSpan
_ BaseType
baseType Maybe (Selector (Analysis a))
_) Maybe (AList Attribute (Analysis a))
mAttrAList AList Declarator (Analysis a)
declAList)
  | [Attribute (Analysis a)]
mAttrs  <- [Attribute (Analysis a)]
-> (AList Attribute (Analysis a) -> [Attribute (Analysis a)])
-> Maybe (AList Attribute (Analysis a))
-> [Attribute (Analysis a)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] AList Attribute (Analysis a) -> [Attribute (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip Maybe (AList Attribute (Analysis a))
mAttrAList
  , Maybe (Attribute (Analysis a))
attrDim <- (Attribute (Analysis a) -> Bool)
-> [Attribute (Analysis a)] -> Maybe (Attribute (Analysis a))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Attribute (Analysis a) -> Bool
forall a. Attribute a -> Bool
isAttrDimension [Attribute (Analysis a)]
mAttrs
  , Bool
isParam <- (Attribute (Analysis a) -> Bool)
-> [Attribute (Analysis a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Attribute (Analysis a) -> Bool
forall a. Attribute a -> Bool
isAttrParameter [Attribute (Analysis a)]
mAttrs
  , Bool
isExtrn <- (Attribute (Analysis a) -> Bool)
-> [Attribute (Analysis a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Attribute (Analysis a) -> Bool
forall a. Attribute a -> Bool
isAttrExternal [Attribute (Analysis a)]
mAttrs
  , [Declarator (Analysis a)]
decls   <- AList Declarator (Analysis a) -> [Declarator (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Declarator (Analysis a)
declAList = do
    TypeEnv
env <- (InferState -> TypeEnv) -> StateT InferState Identity TypeEnv
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InferState -> TypeEnv
environ
    let cType :: Name -> ConstructType
cType Name
n | Bool
isExtrn                                     = ConstructType
CTExternal
                | Just (AttrDimension Analysis a
_ SrcSpan
_ AList DimensionDeclarator (Analysis a)
ddAList) <- Maybe (Attribute (Analysis a))
attrDim = [(Maybe Int, Maybe Int)] -> ConstructType
CTArray (AList DimensionDeclarator (Analysis a) -> [(Maybe Int, Maybe Int)]
forall a. AList DimensionDeclarator a -> [(Maybe Int, Maybe Int)]
dimDeclarator AList DimensionDeclarator (Analysis a)
ddAList)
                | Bool
isParam                                     = ConstructType
CTParameter
                | Just (IDType Maybe BaseType
_ (Just ConstructType
ct)) <- Name -> TypeEnv -> Maybe IDType
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
n TypeEnv
env
                , ConstructType
ct ConstructType -> ConstructType -> Bool
forall a. Eq a => a -> a -> Bool
/= ConstructType
CTIntrinsic                           = ConstructType
ct
                | Bool
otherwise                                   = ConstructType
CTVariable
    let charLen :: Expression a -> CharacterLen
charLen (ExpValue a
_ SrcSpan
_ (ValInteger Name
i)) = Int -> CharacterLen
CharLenInt (Name -> Int
forall a. Read a => Name -> a
read Name
i)
        charLen (ExpValue a
_ SrcSpan
_ Value a
ValStar)        = CharacterLen
CharLenStar
        charLen Expression a
_                             = CharacterLen
CharLenExp
    let bType :: Maybe (Expression a) -> BaseType
bType (Just Expression a
e)
          | TypeCharacter Maybe CharacterLen
_ Maybe Name
kind <- BaseType
baseType = Maybe CharacterLen -> Maybe Name -> BaseType
TypeCharacter (CharacterLen -> Maybe CharacterLen
forall a. a -> Maybe a
Just (CharacterLen -> Maybe CharacterLen)
-> CharacterLen -> Maybe CharacterLen
forall a b. (a -> b) -> a -> b
$ Expression a -> CharacterLen
forall a. Expression a -> CharacterLen
charLen Expression a
e) Maybe Name
kind
          | Bool
otherwise                        = Maybe CharacterLen -> Maybe Name -> BaseType
TypeCharacter (CharacterLen -> Maybe CharacterLen
forall a. a -> Maybe a
Just (CharacterLen -> Maybe CharacterLen)
-> CharacterLen -> Maybe CharacterLen
forall a b. (a -> b) -> a -> b
$ Expression a -> CharacterLen
forall a. Expression a -> CharacterLen
charLen Expression a
e) Maybe Name
forall a. Maybe a
Nothing
        bType Maybe (Expression a)
Nothing  = BaseType
baseType
    [Declarator (Analysis a)]
-> (Declarator (Analysis a) -> StateT InferState Identity ())
-> StateT InferState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Declarator (Analysis a)]
decls ((Declarator (Analysis a) -> StateT InferState Identity ())
 -> StateT InferState Identity ())
-> (Declarator (Analysis a) -> StateT InferState Identity ())
-> StateT InferState Identity ()
forall a b. (a -> b) -> a -> b
$ \ Declarator (Analysis a)
decl -> case Declarator (Analysis a)
decl of
      DeclArray Analysis a
_ SrcSpan
_ Expression (Analysis a)
v AList DimensionDeclarator (Analysis a)
ddAList Maybe (Expression (Analysis a))
e Maybe (Expression (Analysis a))
_ -> BaseType -> ConstructType -> Name -> StateT InferState Identity ()
recordType (Maybe (Expression (Analysis a)) -> BaseType
forall a. Maybe (Expression a) -> BaseType
bType Maybe (Expression (Analysis a))
e) ([(Maybe Int, Maybe Int)] -> ConstructType
CTArray ([(Maybe Int, Maybe Int)] -> ConstructType)
-> [(Maybe Int, Maybe Int)] -> ConstructType
forall a b. (a -> b) -> a -> b
$ AList DimensionDeclarator (Analysis a) -> [(Maybe Int, Maybe Int)]
forall a. AList DimensionDeclarator a -> [(Maybe Int, Maybe Int)]
dimDeclarator AList DimensionDeclarator (Analysis a)
ddAList) (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v)
      DeclVariable Analysis a
_ SrcSpan
_ Expression (Analysis a)
v Maybe (Expression (Analysis a))
e Maybe (Expression (Analysis a))
_      -> BaseType -> ConstructType -> Name -> StateT InferState Identity ()
recordType (Maybe (Expression (Analysis a)) -> BaseType
forall a. Maybe (Expression a) -> BaseType
bType Maybe (Expression (Analysis a))
e) (Name -> ConstructType
cType Name
n) Name
n where n :: Name
n = Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v

statement (StExternal Analysis a
_ SrcSpan
_ AList Expression (Analysis a)
varAList) = do
  let vars :: [Expression (Analysis a)]
vars = AList Expression (Analysis a) -> [Expression (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Expression (Analysis a)
varAList
  (Expression (Analysis a) -> StateT InferState Identity ())
-> [Expression (Analysis a)] -> StateT InferState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ConstructType -> Name -> StateT InferState Identity ()
recordCType ConstructType
CTExternal (Name -> StateT InferState Identity ())
-> (Expression (Analysis a) -> Name)
-> Expression (Analysis a)
-> StateT InferState Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName) [Expression (Analysis a)]
vars
statement (StExpressionAssign Analysis a
_ SrcSpan
_ (ExpSubscript Analysis a
_ SrcSpan
_ Expression (Analysis a)
v AList Index (Analysis a)
ixAList) Expression (Analysis a)
_)
  --  | any (not . isIxSingle) (aStrip ixAList) = recordCType CTArray (varName v)  -- it's an array (or a string?) FIXME
  | (Index (Analysis a) -> Bool) -> [Index (Analysis a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Index (Analysis a) -> Bool
forall a. Index a -> Bool
isIxSingle (AList Index (Analysis a) -> [Index (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Index (Analysis a)
ixAList) = do
    let n :: Name
n = Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v
    Maybe IDType
mIDType <- Name -> Infer (Maybe IDType)
getRecordedType Name
n
    case Maybe IDType
mIDType of
      Just (IDType Maybe BaseType
_ (Just CTArray{})) -> () -> StateT InferState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()                -- do nothing, it's already known to be an array
      Maybe IDType
_                                -> ConstructType -> Name -> StateT InferState Identity ()
recordCType ConstructType
CTFunction Name
n -- assume it's a function statement

-- FIXME: if StFunctions can only be identified after types analysis
-- is complete and disambiguation is performed, then how do we get
-- them in the first place? (iterate until fixed point?)
statement (StFunction Analysis a
_ SrcSpan
_ Expression (Analysis a)
v AList Expression (Analysis a)
_ Expression (Analysis a)
_) = ConstructType -> Name -> StateT InferState Identity ()
recordCType ConstructType
CTFunction (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v)
-- (part of answer to above is) nullary function statement: foo() = ...
statement (StExpressionAssign Analysis a
_ SrcSpan
_ (ExpFunctionCall Analysis a
_ SrcSpan
_ Expression (Analysis a)
v Maybe (AList Argument (Analysis a))
Nothing) Expression (Analysis a)
_) = ConstructType -> Name -> StateT InferState Identity ()
recordCType ConstructType
CTFunction (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v)

statement (StDimension Analysis a
_ SrcSpan
_ AList Declarator (Analysis a)
declAList) = do
  let decls :: [Declarator (Analysis a)]
decls = AList Declarator (Analysis a) -> [Declarator (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Declarator (Analysis a)
declAList
  [Declarator (Analysis a)]
-> (Declarator (Analysis a) -> StateT InferState Identity ())
-> StateT InferState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Declarator (Analysis a)]
decls ((Declarator (Analysis a) -> StateT InferState Identity ())
 -> StateT InferState Identity ())
-> (Declarator (Analysis a) -> StateT InferState Identity ())
-> StateT InferState Identity ()
forall a b. (a -> b) -> a -> b
$ \ Declarator (Analysis a)
decl -> case Declarator (Analysis a)
decl of
    DeclArray Analysis a
_ SrcSpan
_ Expression (Analysis a)
v AList DimensionDeclarator (Analysis a)
ddAList Maybe (Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_ -> ConstructType -> Name -> StateT InferState Identity ()
recordCType ([(Maybe Int, Maybe Int)] -> ConstructType
CTArray ([(Maybe Int, Maybe Int)] -> ConstructType)
-> [(Maybe Int, Maybe Int)] -> ConstructType
forall a b. (a -> b) -> a -> b
$ AList DimensionDeclarator (Analysis a) -> [(Maybe Int, Maybe Int)]
forall a. AList DimensionDeclarator a -> [(Maybe Int, Maybe Int)]
dimDeclarator AList DimensionDeclarator (Analysis a)
ddAList) (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
v)
    Declarator (Analysis a)
_                           -> () -> StateT InferState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

statement Statement (Analysis a)
_ = () -> StateT InferState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

annotateExpression :: Data a => Expression (Analysis a) -> Infer (Expression (Analysis a))
annotateExpression :: Expression (Analysis a) -> Infer (Expression (Analysis a))
annotateExpression e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ (ValVariable Name
_))    = Expression (Analysis a)
-> (IDType -> Expression (Analysis a))
-> Maybe IDType
-> Expression (Analysis a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expression (Analysis a)
e (IDType -> Expression (Analysis a) -> Expression (Analysis a)
forall (f :: * -> *) a.
Annotated f =>
IDType -> f (Analysis a) -> f (Analysis a)
`setIDType` Expression (Analysis a)
e) (Maybe IDType -> Expression (Analysis a))
-> Infer (Maybe IDType) -> Infer (Expression (Analysis a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Name -> Infer (Maybe IDType)
getRecordedType (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
e)
annotateExpression e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ (ValIntrinsic Name
_))   = Expression (Analysis a)
-> (IDType -> Expression (Analysis a))
-> Maybe IDType
-> Expression (Analysis a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expression (Analysis a)
e (IDType -> Expression (Analysis a) -> Expression (Analysis a)
forall (f :: * -> *) a.
Annotated f =>
IDType -> f (Analysis a) -> f (Analysis a)
`setIDType` Expression (Analysis a)
e) (Maybe IDType -> Expression (Analysis a))
-> Infer (Maybe IDType) -> Infer (Expression (Analysis a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Name -> Infer (Maybe IDType)
getRecordedType (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
varName Expression (Analysis a)
e)
annotateExpression e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ (ValReal Name
r))        = Expression (Analysis a) -> Infer (Expression (Analysis a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression (Analysis a) -> Infer (Expression (Analysis a)))
-> Expression (Analysis a) -> Infer (Expression (Analysis a))
forall a b. (a -> b) -> a -> b
$ Name -> IDType
realLiteralType Name
r IDType -> Expression (Analysis a) -> Expression (Analysis a)
forall (f :: * -> *) a.
Annotated f =>
IDType -> f (Analysis a) -> f (Analysis a)
`setIDType` Expression (Analysis a)
e
annotateExpression e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ (ValComplex Expression (Analysis a)
e1 Expression (Analysis a)
e2)) = Expression (Analysis a) -> Infer (Expression (Analysis a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression (Analysis a) -> Infer (Expression (Analysis a)))
-> Expression (Analysis a) -> Infer (Expression (Analysis a))
forall a b. (a -> b) -> a -> b
$ Expression (Analysis a) -> Expression (Analysis a) -> IDType
forall a. Expression a -> Expression a -> IDType
complexLiteralType Expression (Analysis a)
e1 Expression (Analysis a)
e2 IDType -> Expression (Analysis a) -> Expression (Analysis a)
forall (f :: * -> *) a.
Annotated f =>
IDType -> f (Analysis a) -> f (Analysis a)
`setIDType` Expression (Analysis a)
e
annotateExpression e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ (ValInteger Name
_))     = Expression (Analysis a) -> Infer (Expression (Analysis a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression (Analysis a) -> Infer (Expression (Analysis a)))
-> Expression (Analysis a) -> Infer (Expression (Analysis a))
forall a b. (a -> b) -> a -> b
$ Maybe BaseType -> Maybe ConstructType -> IDType
IDType (BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeInteger) Maybe ConstructType
forall a. Maybe a
Nothing IDType -> Expression (Analysis a) -> Expression (Analysis a)
forall (f :: * -> *) a.
Annotated f =>
IDType -> f (Analysis a) -> f (Analysis a)
`setIDType` Expression (Analysis a)
e
annotateExpression e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ (ValLogical Name
_))     = Expression (Analysis a) -> Infer (Expression (Analysis a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression (Analysis a) -> Infer (Expression (Analysis a)))
-> Expression (Analysis a) -> Infer (Expression (Analysis a))
forall a b. (a -> b) -> a -> b
$ Maybe BaseType -> Maybe ConstructType -> IDType
IDType (BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeLogical) Maybe ConstructType
forall a. Maybe a
Nothing IDType -> Expression (Analysis a) -> Expression (Analysis a)
forall (f :: * -> *) a.
Annotated f =>
IDType -> f (Analysis a) -> f (Analysis a)
`setIDType` Expression (Analysis a)
e
annotateExpression e :: Expression (Analysis a)
e@(ExpBinary Analysis a
_ SrcSpan
_ BinaryOp
op Expression (Analysis a)
e1 Expression (Analysis a)
e2)          = (IDType -> Expression (Analysis a) -> Expression (Analysis a))
-> Expression (Analysis a) -> IDType -> Expression (Analysis a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip IDType -> Expression (Analysis a) -> Expression (Analysis a)
forall (f :: * -> *) a.
Annotated f =>
IDType -> f (Analysis a) -> f (Analysis a)
setIDType Expression (Analysis a)
e (IDType -> Expression (Analysis a))
-> StateT InferState Identity IDType
-> Infer (Expression (Analysis a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` SrcSpan
-> BinaryOp
-> Expression (Analysis a)
-> Expression (Analysis a)
-> StateT InferState Identity IDType
forall a.
Data a =>
SrcSpan
-> BinaryOp
-> Expression (Analysis a)
-> Expression (Analysis a)
-> StateT InferState Identity IDType
binaryOpType (Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
e) BinaryOp
op Expression (Analysis a)
e1 Expression (Analysis a)
e2
annotateExpression e :: Expression (Analysis a)
e@(ExpUnary Analysis a
_ SrcSpan
_ UnaryOp
op Expression (Analysis a)
e1)              = (IDType -> Expression (Analysis a) -> Expression (Analysis a))
-> Expression (Analysis a) -> IDType -> Expression (Analysis a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip IDType -> Expression (Analysis a) -> Expression (Analysis a)
forall (f :: * -> *) a.
Annotated f =>
IDType -> f (Analysis a) -> f (Analysis a)
setIDType Expression (Analysis a)
e (IDType -> Expression (Analysis a))
-> StateT InferState Identity IDType
-> Infer (Expression (Analysis a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` SrcSpan
-> UnaryOp
-> Expression (Analysis a)
-> StateT InferState Identity IDType
forall a.
Data a =>
SrcSpan
-> UnaryOp
-> Expression (Analysis a)
-> StateT InferState Identity IDType
unaryOpType (Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
e1) UnaryOp
op Expression (Analysis a)
e1
annotateExpression e :: Expression (Analysis a)
e@(ExpSubscript Analysis a
_ SrcSpan
_ Expression (Analysis a)
e1 AList Index (Analysis a)
idxAList)    = (IDType -> Expression (Analysis a) -> Expression (Analysis a))
-> Expression (Analysis a) -> IDType -> Expression (Analysis a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip IDType -> Expression (Analysis a) -> Expression (Analysis a)
forall (f :: * -> *) a.
Annotated f =>
IDType -> f (Analysis a) -> f (Analysis a)
setIDType Expression (Analysis a)
e (IDType -> Expression (Analysis a))
-> StateT InferState Identity IDType
-> Infer (Expression (Analysis a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` SrcSpan
-> Expression (Analysis a)
-> AList Index (Analysis a)
-> StateT InferState Identity IDType
forall a.
Data a =>
SrcSpan
-> Expression (Analysis a)
-> AList Index (Analysis a)
-> StateT InferState Identity IDType
subscriptType (Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
e) Expression (Analysis a)
e1 AList Index (Analysis a)
idxAList
annotateExpression e :: Expression (Analysis a)
e@(ExpFunctionCall Analysis a
_ SrcSpan
_ Expression (Analysis a)
e1 Maybe (AList Argument (Analysis a))
parAList) = (IDType -> Expression (Analysis a) -> Expression (Analysis a))
-> Expression (Analysis a) -> IDType -> Expression (Analysis a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip IDType -> Expression (Analysis a) -> Expression (Analysis a)
forall (f :: * -> *) a.
Annotated f =>
IDType -> f (Analysis a) -> f (Analysis a)
setIDType Expression (Analysis a)
e (IDType -> Expression (Analysis a))
-> StateT InferState Identity IDType
-> Infer (Expression (Analysis a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` SrcSpan
-> Expression (Analysis a)
-> Maybe (AList Argument (Analysis a))
-> StateT InferState Identity IDType
forall a.
Data a =>
SrcSpan
-> Expression (Analysis a)
-> Maybe (AList Argument (Analysis a))
-> StateT InferState Identity IDType
functionCallType (Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
e) Expression (Analysis a)
e1 Maybe (AList Argument (Analysis a))
parAList
annotateExpression Expression (Analysis a)
e                                   = Expression (Analysis a) -> Infer (Expression (Analysis a))
forall (m :: * -> *) a. Monad m => a -> m a
return Expression (Analysis a)
e

annotateProgramUnit :: Data a => ProgramUnit (Analysis a) -> Infer (ProgramUnit (Analysis a))
annotateProgramUnit :: ProgramUnit (Analysis a) -> Infer (ProgramUnit (Analysis a))
annotateProgramUnit ProgramUnit (Analysis a)
pu | Named Name
n <- ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
puName ProgramUnit (Analysis a)
pu = ProgramUnit (Analysis a)
-> (IDType -> ProgramUnit (Analysis a))
-> Maybe IDType
-> ProgramUnit (Analysis a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ProgramUnit (Analysis a)
pu (IDType -> ProgramUnit (Analysis a) -> ProgramUnit (Analysis a)
forall (f :: * -> *) a.
Annotated f =>
IDType -> f (Analysis a) -> f (Analysis a)
`setIDType` ProgramUnit (Analysis a)
pu) (Maybe IDType -> ProgramUnit (Analysis a))
-> Infer (Maybe IDType) -> Infer (ProgramUnit (Analysis a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Name -> Infer (Maybe IDType)
getRecordedType Name
n
annotateProgramUnit ProgramUnit (Analysis a)
pu                        = ProgramUnit (Analysis a) -> Infer (ProgramUnit (Analysis a))
forall (m :: * -> *) a. Monad m => a -> m a
return ProgramUnit (Analysis a)
pu

realLiteralType :: String -> IDType
realLiteralType :: Name -> IDType
realLiteralType Name
r | Char
'd' Char -> Name -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Name
r = Maybe BaseType -> Maybe ConstructType -> IDType
IDType (BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeDoublePrecision) Maybe ConstructType
forall a. Maybe a
Nothing
                  | Bool
otherwise    = Maybe BaseType -> Maybe ConstructType -> IDType
IDType (BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeReal) Maybe ConstructType
forall a. Maybe a
Nothing

complexLiteralType :: Expression a -> Expression a -> IDType
complexLiteralType :: Expression a -> Expression a -> IDType
complexLiteralType (ExpValue a
_ SrcSpan
_ (ValReal Name
r)) Expression a
_
 | IDType (Just BaseType
TypeDoublePrecision) Maybe ConstructType
_ <- Name -> IDType
realLiteralType Name
r = Maybe BaseType -> Maybe ConstructType -> IDType
IDType (BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeDoubleComplex) Maybe ConstructType
forall a. Maybe a
Nothing
 | Bool
otherwise                                                = Maybe BaseType -> Maybe ConstructType -> IDType
IDType (BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeComplex) Maybe ConstructType
forall a. Maybe a
Nothing
complexLiteralType Expression a
_ Expression a
_ = Maybe BaseType -> Maybe ConstructType -> IDType
IDType (BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeComplex) Maybe ConstructType
forall a. Maybe a
Nothing

binaryOpType :: Data a => SrcSpan -> BinaryOp -> Expression (Analysis a) -> Expression (Analysis a) -> Infer IDType
binaryOpType :: SrcSpan
-> BinaryOp
-> Expression (Analysis a)
-> Expression (Analysis a)
-> StateT InferState Identity IDType
binaryOpType SrcSpan
ss BinaryOp
op Expression (Analysis a)
e1 Expression (Analysis a)
e2 = do
  Maybe BaseType
mbt1 <- case Expression (Analysis a) -> Maybe IDType
forall (f :: * -> *) a.
(Annotated f, Data a) =>
f (Analysis a) -> Maybe IDType
getIDType Expression (Analysis a)
e1 of
            Just (IDType (Just BaseType
bt) Maybe ConstructType
_) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
bt
            Maybe IDType
_ -> Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"Unable to obtain type for first operand" (Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
e1) StateT InferState Identity ()
-> StateT InferState Identity (Maybe BaseType)
-> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseType
forall a. Maybe a
Nothing
  Maybe BaseType
mbt2 <- case Expression (Analysis a) -> Maybe IDType
forall (f :: * -> *) a.
(Annotated f, Data a) =>
f (Analysis a) -> Maybe IDType
getIDType Expression (Analysis a)
e2 of
            Just (IDType (Just BaseType
bt) Maybe ConstructType
_) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
bt
            Maybe IDType
_ -> Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"Unable to obtain type for second operand" (Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
e2) StateT InferState Identity ()
-> StateT InferState Identity (Maybe BaseType)
-> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseType
forall a. Maybe a
Nothing
  case (Maybe BaseType
mbt1, Maybe BaseType
mbt2) of
    (Maybe BaseType
_, Maybe BaseType
Nothing) -> IDType -> StateT InferState Identity IDType
forall (m :: * -> *) a. Monad m => a -> m a
return IDType
emptyType
    (Maybe BaseType
Nothing, Maybe BaseType
_) -> IDType -> StateT InferState Identity IDType
forall (m :: * -> *) a. Monad m => a -> m a
return IDType
emptyType
    (Just BaseType
bt1, Just BaseType
bt2) -> do
      Maybe BaseType
mbt <- case (BaseType
bt1, BaseType
bt2) of
        (BaseType
_                   , BaseType
TypeDoubleComplex   ) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> (BaseType -> Maybe BaseType)
-> BaseType
-> StateT InferState Identity (Maybe BaseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just (BaseType -> StateT InferState Identity (Maybe BaseType))
-> BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType
TypeDoubleComplex
        (BaseType
TypeDoubleComplex   , BaseType
_                   ) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> (BaseType -> Maybe BaseType)
-> BaseType
-> StateT InferState Identity (Maybe BaseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just (BaseType -> StateT InferState Identity (Maybe BaseType))
-> BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType
TypeDoubleComplex
        (BaseType
_                   , BaseType
TypeComplex         ) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> (BaseType -> Maybe BaseType)
-> BaseType
-> StateT InferState Identity (Maybe BaseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just (BaseType -> StateT InferState Identity (Maybe BaseType))
-> BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType
TypeComplex
        (BaseType
TypeComplex         , BaseType
_                   ) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> (BaseType -> Maybe BaseType)
-> BaseType
-> StateT InferState Identity (Maybe BaseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just (BaseType -> StateT InferState Identity (Maybe BaseType))
-> BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType
TypeComplex
        (BaseType
_                   , BaseType
TypeDoublePrecision ) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> (BaseType -> Maybe BaseType)
-> BaseType
-> StateT InferState Identity (Maybe BaseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just (BaseType -> StateT InferState Identity (Maybe BaseType))
-> BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType
TypeDoublePrecision
        (BaseType
TypeDoublePrecision , BaseType
_                   ) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> (BaseType -> Maybe BaseType)
-> BaseType
-> StateT InferState Identity (Maybe BaseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just (BaseType -> StateT InferState Identity (Maybe BaseType))
-> BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType
TypeDoublePrecision
        (BaseType
_                   , BaseType
TypeReal            ) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> (BaseType -> Maybe BaseType)
-> BaseType
-> StateT InferState Identity (Maybe BaseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just (BaseType -> StateT InferState Identity (Maybe BaseType))
-> BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType
TypeReal
        (BaseType
TypeReal            , BaseType
_                   ) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> (BaseType -> Maybe BaseType)
-> BaseType
-> StateT InferState Identity (Maybe BaseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just (BaseType -> StateT InferState Identity (Maybe BaseType))
-> BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType
TypeReal
        (BaseType
_                   , BaseType
TypeInteger         ) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> (BaseType -> Maybe BaseType)
-> BaseType
-> StateT InferState Identity (Maybe BaseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just (BaseType -> StateT InferState Identity (Maybe BaseType))
-> BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType
TypeInteger
        (BaseType
TypeInteger         , BaseType
_                   ) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> (BaseType -> Maybe BaseType)
-> BaseType
-> StateT InferState Identity (Maybe BaseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just (BaseType -> StateT InferState Identity (Maybe BaseType))
-> BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType
TypeInteger
        (BaseType
TypeByte            , BaseType
TypeByte            ) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> (BaseType -> Maybe BaseType)
-> BaseType
-> StateT InferState Identity (Maybe BaseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just (BaseType -> StateT InferState Identity (Maybe BaseType))
-> BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType
TypeByte
        (BaseType
TypeLogical         , BaseType
TypeLogical         ) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> (BaseType -> Maybe BaseType)
-> BaseType
-> StateT InferState Identity (Maybe BaseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just (BaseType -> StateT InferState Identity (Maybe BaseType))
-> BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType
TypeLogical
        (TypeCustom Name
_        , TypeCustom Name
_        ) -> do
          Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"custom types / binary op not supported" SrcSpan
ss
          Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseType
forall a. Maybe a
Nothing
        (TypeCharacter Maybe CharacterLen
l1 Maybe Name
k1 , TypeCharacter Maybe CharacterLen
l2 Maybe Name
_ )
          | BinaryOp
op BinaryOp -> BinaryOp -> Bool
forall a. Eq a => a -> a -> Bool
== BinaryOp
Concatenation -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> (BaseType -> Maybe BaseType)
-> BaseType
-> StateT InferState Identity (Maybe BaseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just (BaseType -> StateT InferState Identity (Maybe BaseType))
-> BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ Maybe CharacterLen -> Maybe Name -> BaseType
TypeCharacter ((CharacterLen -> CharacterLen -> CharacterLen)
-> Maybe CharacterLen -> Maybe CharacterLen -> Maybe CharacterLen
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 CharacterLen -> CharacterLen -> CharacterLen
charLenConcat Maybe CharacterLen
l1 Maybe CharacterLen
l2) Maybe Name
k1
          | BinaryOp
op BinaryOp -> [BinaryOp] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BinaryOp
EQ, BinaryOp
NE]  -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeLogical
          | Bool
otherwise -> do Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"Invalid op on character strings" SrcSpan
ss
                            Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseType
forall a. Maybe a
Nothing
        (BaseType, BaseType)
_ -> do Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"Type error between operands of binary operator" SrcSpan
ss
                Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseType
forall a. Maybe a
Nothing
      Maybe BaseType
mbt' <- case Maybe BaseType
mbt of
        Just BaseType
bt
          | BinaryOp
op BinaryOp -> [BinaryOp] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ BinaryOp
Addition, BinaryOp
Subtraction, BinaryOp
Multiplication, BinaryOp
Division
                      , BinaryOp
Exponentiation, BinaryOp
Concatenation, BinaryOp
Or, BinaryOp
XOr, BinaryOp
And ]       -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
bt
          | BinaryOp
op BinaryOp -> [BinaryOp] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BinaryOp
GT, BinaryOp
GTE, BinaryOp
LT, BinaryOp
LTE, BinaryOp
EQ, BinaryOp
NE, BinaryOp
Equivalent, BinaryOp
NotEquivalent] -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeLogical
          | BinCustom{} <- BinaryOp
op -> Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"custom binary ops not supported" SrcSpan
ss StateT InferState Identity ()
-> StateT InferState Identity (Maybe BaseType)
-> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseType
forall a. Maybe a
Nothing
        Maybe BaseType
_ -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseType
forall a. Maybe a
Nothing

      IDType -> StateT InferState Identity IDType
forall (m :: * -> *) a. Monad m => a -> m a
return (IDType -> StateT InferState Identity IDType)
-> IDType -> StateT InferState Identity IDType
forall a b. (a -> b) -> a -> b
$ Maybe BaseType -> Maybe ConstructType -> IDType
IDType Maybe BaseType
mbt' Maybe ConstructType
forall a. Maybe a
Nothing

unaryOpType :: Data a => SrcSpan -> UnaryOp -> Expression (Analysis a) -> Infer IDType
unaryOpType :: SrcSpan
-> UnaryOp
-> Expression (Analysis a)
-> StateT InferState Identity IDType
unaryOpType SrcSpan
ss UnaryOp
op Expression (Analysis a)
e = do
  Maybe BaseType
mbt <- case Expression (Analysis a) -> Maybe IDType
forall (f :: * -> *) a.
(Annotated f, Data a) =>
f (Analysis a) -> Maybe IDType
getIDType Expression (Analysis a)
e of
           Just (IDType (Just BaseType
bt) Maybe ConstructType
_) -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
bt
           Maybe IDType
_ -> Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"Unable to obtain type for" (Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
e) StateT InferState Identity ()
-> StateT InferState Identity (Maybe BaseType)
-> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseType
forall a. Maybe a
Nothing
  Maybe BaseType
mbt' <- case (Maybe BaseType
mbt, UnaryOp
op) of
    (Maybe BaseType
Nothing, UnaryOp
_)               -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseType
forall a. Maybe a
Nothing
    (Just TypeCustom{}, UnaryOp
_)     -> Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"custom types / unary ops not supported" SrcSpan
ss StateT InferState Identity ()
-> StateT InferState Identity (Maybe BaseType)
-> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseType
forall a. Maybe a
Nothing
    (Maybe BaseType
_, UnCustom{})            -> Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"custom unary ops not supported" SrcSpan
ss StateT InferState Identity ()
-> StateT InferState Identity (Maybe BaseType)
-> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseType
forall a. Maybe a
Nothing
    (Just BaseType
TypeLogical, UnaryOp
Not)    -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeLogical
    (Just BaseType
bt, UnaryOp
_)
      | UnaryOp
op UnaryOp -> [UnaryOp] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UnaryOp
Plus, UnaryOp
Minus] Bool -> Bool -> Bool
&&
        BaseType
bt BaseType -> [BaseType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BaseType]
numericTypes -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
bt
    (Maybe BaseType, UnaryOp)
_ -> Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"Type error for unary operator" SrcSpan
ss StateT InferState Identity ()
-> StateT InferState Identity (Maybe BaseType)
-> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseType
forall a. Maybe a
Nothing
  IDType -> StateT InferState Identity IDType
forall (m :: * -> *) a. Monad m => a -> m a
return (IDType -> StateT InferState Identity IDType)
-> IDType -> StateT InferState Identity IDType
forall a b. (a -> b) -> a -> b
$ Maybe BaseType -> Maybe ConstructType -> IDType
IDType Maybe BaseType
mbt' Maybe ConstructType
forall a. Maybe a
Nothing

subscriptType :: Data a => SrcSpan -> Expression (Analysis a) -> AList Index (Analysis a) -> Infer IDType
subscriptType :: SrcSpan
-> Expression (Analysis a)
-> AList Index (Analysis a)
-> StateT InferState Identity IDType
subscriptType SrcSpan
ss Expression (Analysis a)
e1 (AList Analysis a
_ SrcSpan
_ [Index (Analysis a)]
idxs) = do
  let isInteger :: f (Analysis a) -> Bool
isInteger f (Analysis a)
ie | Just (IDType (Just BaseType
TypeInteger) Maybe ConstructType
_) <- f (Analysis a) -> Maybe IDType
forall (f :: * -> *) a.
(Annotated f, Data a) =>
f (Analysis a) -> Maybe IDType
getIDType f (Analysis a)
ie = Bool
True | Bool
otherwise = Bool
False
  [Index (Analysis a)]
-> (Index (Analysis a) -> StateT InferState Identity ())
-> StateT InferState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Index (Analysis a)]
idxs ((Index (Analysis a) -> StateT InferState Identity ())
 -> StateT InferState Identity ())
-> (Index (Analysis a) -> StateT InferState Identity ())
-> StateT InferState Identity ()
forall a b. (a -> b) -> a -> b
$ \ Index (Analysis a)
idx -> case Index (Analysis a)
idx of
    IxSingle Analysis a
_ SrcSpan
_ Maybe Name
_ Expression (Analysis a)
ie
      | Bool -> Bool
not (Expression (Analysis a) -> Bool
forall (f :: * -> *) a.
(Annotated f, Data a) =>
f (Analysis a) -> Bool
isInteger Expression (Analysis a)
ie) -> Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"Invalid or unknown type for index" (Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
ie)
    IxRange Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
mie1 Maybe (Expression (Analysis a))
mie2 Maybe (Expression (Analysis a))
mie3
      | Just Expression (Analysis a)
ie1 <- Maybe (Expression (Analysis a))
mie1, Bool -> Bool
not (Expression (Analysis a) -> Bool
forall (f :: * -> *) a.
(Annotated f, Data a) =>
f (Analysis a) -> Bool
isInteger Expression (Analysis a)
ie1) -> Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"Invalid or unknown type for index" (Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
ie1)
      | Just Expression (Analysis a)
ie2 <- Maybe (Expression (Analysis a))
mie2, Bool -> Bool
not (Expression (Analysis a) -> Bool
forall (f :: * -> *) a.
(Annotated f, Data a) =>
f (Analysis a) -> Bool
isInteger Expression (Analysis a)
ie2) -> Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"Invalid or unknown type for index" (Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
ie2)
      | Just Expression (Analysis a)
ie3 <- Maybe (Expression (Analysis a))
mie3, Bool -> Bool
not (Expression (Analysis a) -> Bool
forall (f :: * -> *) a.
(Annotated f, Data a) =>
f (Analysis a) -> Bool
isInteger Expression (Analysis a)
ie3) -> Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"Invalid or unknown type for index" (Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression (Analysis a)
ie3)
    Index (Analysis a)
_ -> () -> StateT InferState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  case Expression (Analysis a) -> Maybe IDType
forall (f :: * -> *) a.
(Annotated f, Data a) =>
f (Analysis a) -> Maybe IDType
getIDType Expression (Analysis a)
e1 of
    Just ty :: IDType
ty@(IDType Maybe BaseType
mbt (Just (CTArray [(Maybe Int, Maybe Int)]
dds))) -> do
      Bool
-> StateT InferState Identity () -> StateT InferState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Index (Analysis a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Index (Analysis a)]
idxs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [(Maybe Int, Maybe Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Maybe Int, Maybe Int)]
dds) (StateT InferState Identity () -> StateT InferState Identity ())
-> StateT InferState Identity () -> StateT InferState Identity ()
forall a b. (a -> b) -> a -> b
$ Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"Length of indices does not match rank of array." SrcSpan
ss
      let isSingle :: Index a -> Bool
isSingle (IxSingle{}) = Bool
True; isSingle Index a
_ = Bool
False
      if (Index (Analysis a) -> Bool) -> [Index (Analysis a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Index (Analysis a) -> Bool
forall a. Index a -> Bool
isSingle [Index (Analysis a)]
idxs
        then IDType -> StateT InferState Identity IDType
forall (m :: * -> *) a. Monad m => a -> m a
return (IDType -> StateT InferState Identity IDType)
-> IDType -> StateT InferState Identity IDType
forall a b. (a -> b) -> a -> b
$ Maybe BaseType -> Maybe ConstructType -> IDType
IDType Maybe BaseType
mbt Maybe ConstructType
forall a. Maybe a
Nothing
        else IDType -> StateT InferState Identity IDType
forall (m :: * -> *) a. Monad m => a -> m a
return IDType
ty
    Maybe IDType
_ -> IDType -> StateT InferState Identity IDType
forall (m :: * -> *) a. Monad m => a -> m a
return IDType
emptyType

functionCallType :: Data a => SrcSpan -> Expression (Analysis a) -> Maybe (AList Argument (Analysis a)) -> Infer IDType
functionCallType :: SrcSpan
-> Expression (Analysis a)
-> Maybe (AList Argument (Analysis a))
-> StateT InferState Identity IDType
functionCallType SrcSpan
ss (ExpValue Analysis a
_ SrcSpan
_ (ValIntrinsic Name
n)) (Just (AList Analysis a
_ SrcSpan
_ [Argument (Analysis a)]
params)) = do
  IntrinsicsTable
itab <- (InferState -> IntrinsicsTable)
-> StateT InferState Identity IntrinsicsTable
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InferState -> IntrinsicsTable
intrinsics
  let mRetType :: Maybe IntrinsicType
mRetType = Name -> IntrinsicsTable -> Maybe IntrinsicType
getIntrinsicReturnType Name
n IntrinsicsTable
itab
  case Maybe IntrinsicType
mRetType of
    Maybe IntrinsicType
Nothing -> IDType -> StateT InferState Identity IDType
forall (m :: * -> *) a. Monad m => a -> m a
return IDType
emptyType
    Just IntrinsicType
retType -> do
      Maybe BaseType
mbt <- case IntrinsicType
retType of
            IntrinsicType
ITReal      -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeReal
            IntrinsicType
ITInteger   -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeInteger
            IntrinsicType
ITComplex   -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeComplex
            IntrinsicType
ITDouble    -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeDoublePrecision
            IntrinsicType
ITLogical   -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
TypeLogical
            IntrinsicType
ITCharacter -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> (BaseType -> Maybe BaseType)
-> BaseType
-> StateT InferState Identity (Maybe BaseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just (BaseType -> StateT InferState Identity (Maybe BaseType))
-> BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ Maybe CharacterLen -> Maybe Name -> BaseType
TypeCharacter Maybe CharacterLen
forall a. Maybe a
Nothing Maybe Name
forall a. Maybe a
Nothing
            ITParam Int
i
              | [Argument (Analysis a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Argument (Analysis a)]
params Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i, Argument Analysis a
_ SrcSpan
_ Maybe Name
_ Expression (Analysis a)
e <- [Argument (Analysis a)]
params [Argument (Analysis a)] -> Int -> Argument (Analysis a)
forall a. [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                -> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseType -> StateT InferState Identity (Maybe BaseType))
-> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall a b. (a -> b) -> a -> b
$ IDType -> Maybe BaseType
idVType (IDType -> Maybe BaseType) -> Maybe IDType -> Maybe BaseType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Expression (Analysis a) -> Maybe IDType
forall (f :: * -> *) a.
(Annotated f, Data a) =>
f (Analysis a) -> Maybe IDType
getIDType Expression (Analysis a)
e
              | Bool
otherwise -> Name -> SrcSpan -> StateT InferState Identity ()
typeError (Name
"Invalid parameter list to intrinsic '" Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
n Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
"'") SrcSpan
ss StateT InferState Identity ()
-> StateT InferState Identity (Maybe BaseType)
-> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe BaseType -> StateT InferState Identity (Maybe BaseType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseType
forall a. Maybe a
Nothing
      case Maybe BaseType
mbt of
        Maybe BaseType
Nothing -> IDType -> StateT InferState Identity IDType
forall (m :: * -> *) a. Monad m => a -> m a
return IDType
emptyType
        Just BaseType
_ -> IDType -> StateT InferState Identity IDType
forall (m :: * -> *) a. Monad m => a -> m a
return (IDType -> StateT InferState Identity IDType)
-> IDType -> StateT InferState Identity IDType
forall a b. (a -> b) -> a -> b
$ Maybe BaseType -> Maybe ConstructType -> IDType
IDType Maybe BaseType
mbt Maybe ConstructType
forall a. Maybe a
Nothing
functionCallType SrcSpan
ss Expression (Analysis a)
e1 Maybe (AList Argument (Analysis a))
_ = case Expression (Analysis a) -> Maybe IDType
forall (f :: * -> *) a.
(Annotated f, Data a) =>
f (Analysis a) -> Maybe IDType
getIDType Expression (Analysis a)
e1 of
  Just (IDType (Just BaseType
bt) (Just ConstructType
CTFunction)) -> IDType -> StateT InferState Identity IDType
forall (m :: * -> *) a. Monad m => a -> m a
return (IDType -> StateT InferState Identity IDType)
-> IDType -> StateT InferState Identity IDType
forall a b. (a -> b) -> a -> b
$ Maybe BaseType -> Maybe ConstructType -> IDType
IDType (BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
bt) Maybe ConstructType
forall a. Maybe a
Nothing
  Just (IDType (Just BaseType
bt) (Just ConstructType
CTExternal)) -> IDType -> StateT InferState Identity IDType
forall (m :: * -> *) a. Monad m => a -> m a
return (IDType -> StateT InferState Identity IDType)
-> IDType -> StateT InferState Identity IDType
forall a b. (a -> b) -> a -> b
$ Maybe BaseType -> Maybe ConstructType -> IDType
IDType (BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
bt) Maybe ConstructType
forall a. Maybe a
Nothing
  Maybe IDType
_ -> Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
"non-function invoked by call" SrcSpan
ss StateT InferState Identity ()
-> StateT InferState Identity IDType
-> StateT InferState Identity IDType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IDType -> StateT InferState Identity IDType
forall (m :: * -> *) a. Monad m => a -> m a
return IDType
emptyType

charLenConcat :: CharacterLen -> CharacterLen -> CharacterLen
charLenConcat :: CharacterLen -> CharacterLen -> CharacterLen
charLenConcat CharacterLen
l1 CharacterLen
l2 = case (CharacterLen
l1, CharacterLen
l2) of
  (CharacterLen
CharLenExp    , CharacterLen
_             ) -> CharacterLen
CharLenExp
  (CharacterLen
_             , CharacterLen
CharLenExp    ) -> CharacterLen
CharLenExp
  (CharacterLen
CharLenStar   , CharacterLen
_             ) -> CharacterLen
CharLenStar
  (CharacterLen
_             , CharacterLen
CharLenStar   ) -> CharacterLen
CharLenStar
  (CharacterLen
CharLenColon  , CharacterLen
_             ) -> CharacterLen
CharLenColon
  (CharacterLen
_             , CharacterLen
CharLenColon  ) -> CharacterLen
CharLenColon
  (CharLenInt Int
i1 , CharLenInt Int
i2 ) -> Int -> CharacterLen
CharLenInt (Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i2)

numericTypes :: [BaseType]
numericTypes :: [BaseType]
numericTypes = [BaseType
TypeDoubleComplex, BaseType
TypeComplex, BaseType
TypeDoublePrecision, BaseType
TypeReal, BaseType
TypeInteger, BaseType
TypeByte]

--------------------------------------------------
-- Monadic helper combinators.

inferState0 :: FortranVersion -> InferState
inferState0 :: FortranVersion -> InferState
inferState0 FortranVersion
v = InferState :: FortranVersion
-> IntrinsicsTable
-> TypeEnv
-> Map Name (Name, Maybe Name)
-> [TypeError]
-> InferState
InferState { environ :: TypeEnv
environ = TypeEnv
forall k a. Map k a
M.empty, entryPoints :: Map Name (Name, Maybe Name)
entryPoints = Map Name (Name, Maybe Name)
forall k a. Map k a
M.empty, langVersion :: FortranVersion
langVersion = FortranVersion
v
                           , intrinsics :: IntrinsicsTable
intrinsics = FortranVersion -> IntrinsicsTable
getVersionIntrinsics FortranVersion
v, typeErrors :: [TypeError]
typeErrors = [] }
runInfer :: FortranVersion -> TypeEnv -> State InferState a -> (a, InferState)
runInfer :: FortranVersion -> TypeEnv -> State InferState a -> (a, InferState)
runInfer FortranVersion
v TypeEnv
env = (State InferState a -> InferState -> (a, InferState))
-> InferState -> State InferState a -> (a, InferState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State InferState a -> InferState -> (a, InferState)
forall s a. State s a -> s -> (a, s)
runState ((FortranVersion -> InferState
inferState0 FortranVersion
v) { environ :: TypeEnv
environ = TypeEnv
env })

typeError :: String -> SrcSpan -> Infer ()
typeError :: Name -> SrcSpan -> StateT InferState Identity ()
typeError Name
msg SrcSpan
ss = (InferState -> InferState) -> StateT InferState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InferState -> InferState) -> StateT InferState Identity ())
-> (InferState -> InferState) -> StateT InferState Identity ()
forall a b. (a -> b) -> a -> b
$ \ InferState
s -> InferState
s { typeErrors :: [TypeError]
typeErrors = (Name
msg, SrcSpan
ss)TypeError -> [TypeError] -> [TypeError]
forall a. a -> [a] -> [a]
:InferState -> [TypeError]
typeErrors InferState
s }

emptyType :: IDType
emptyType :: IDType
emptyType = Maybe BaseType -> Maybe ConstructType -> IDType
IDType Maybe BaseType
forall a. Maybe a
Nothing Maybe ConstructType
forall a. Maybe a
Nothing

-- Record the type of the given name.
recordType :: BaseType -> ConstructType -> Name -> Infer ()
recordType :: BaseType -> ConstructType -> Name -> StateT InferState Identity ()
recordType BaseType
bt ConstructType
ct Name
n = (InferState -> InferState) -> StateT InferState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InferState -> InferState) -> StateT InferState Identity ())
-> (InferState -> InferState) -> StateT InferState Identity ()
forall a b. (a -> b) -> a -> b
$ \ InferState
s -> InferState
s { environ :: TypeEnv
environ = Name -> IDType -> TypeEnv -> TypeEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Name
n (Maybe BaseType -> Maybe ConstructType -> IDType
IDType (BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
bt) (ConstructType -> Maybe ConstructType
forall a. a -> Maybe a
Just ConstructType
ct)) (InferState -> TypeEnv
environ InferState
s) }

-- Record the type (maybe) of the given name.
recordMType :: Maybe BaseType -> Maybe ConstructType -> Name -> Infer ()
recordMType :: Maybe BaseType
-> Maybe ConstructType -> Name -> StateT InferState Identity ()
recordMType Maybe BaseType
bt Maybe ConstructType
ct Name
n = (InferState -> InferState) -> StateT InferState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InferState -> InferState) -> StateT InferState Identity ())
-> (InferState -> InferState) -> StateT InferState Identity ()
forall a b. (a -> b) -> a -> b
$ \ InferState
s -> InferState
s { environ :: TypeEnv
environ = Name -> IDType -> TypeEnv -> TypeEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Name
n (Maybe BaseType -> Maybe ConstructType -> IDType
IDType Maybe BaseType
bt Maybe ConstructType
ct) (InferState -> TypeEnv
environ InferState
s) }

-- Record the CType of the given name.
recordCType :: ConstructType -> Name -> Infer ()
recordCType :: ConstructType -> Name -> StateT InferState Identity ()
recordCType ConstructType
ct Name
n = (InferState -> InferState) -> StateT InferState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InferState -> InferState) -> StateT InferState Identity ())
-> (InferState -> InferState) -> StateT InferState Identity ()
forall a b. (a -> b) -> a -> b
$ \ InferState
s -> InferState
s { environ :: TypeEnv
environ = (Maybe IDType -> Maybe IDType) -> Name -> TypeEnv -> TypeEnv
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe IDType -> Maybe IDType
changeFunc Name
n (InferState -> TypeEnv
environ InferState
s) }
  where changeFunc :: Maybe IDType -> Maybe IDType
changeFunc Maybe IDType
mIDType = IDType -> Maybe IDType
forall a. a -> Maybe a
Just (Maybe BaseType -> Maybe ConstructType -> IDType
IDType (Maybe IDType
mIDType Maybe IDType -> (IDType -> Maybe BaseType) -> Maybe BaseType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IDType -> Maybe BaseType
idVType) (ConstructType -> Maybe ConstructType
forall a. a -> Maybe a
Just ConstructType
ct))

-- Record the BaseType of the given name.
recordBaseType :: BaseType -> Name -> Infer ()
recordBaseType :: BaseType -> Name -> StateT InferState Identity ()
recordBaseType BaseType
bt Name
n = (InferState -> InferState) -> StateT InferState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InferState -> InferState) -> StateT InferState Identity ())
-> (InferState -> InferState) -> StateT InferState Identity ()
forall a b. (a -> b) -> a -> b
$ \ InferState
s -> InferState
s { environ :: TypeEnv
environ = (Maybe IDType -> Maybe IDType) -> Name -> TypeEnv -> TypeEnv
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe IDType -> Maybe IDType
changeFunc Name
n (InferState -> TypeEnv
environ InferState
s) }
  where changeFunc :: Maybe IDType -> Maybe IDType
changeFunc Maybe IDType
mIDType = IDType -> Maybe IDType
forall a. a -> Maybe a
Just (Maybe BaseType -> Maybe ConstructType -> IDType
IDType (BaseType -> Maybe BaseType
forall a. a -> Maybe a
Just BaseType
bt) (Maybe IDType
mIDType Maybe IDType
-> (IDType -> Maybe ConstructType) -> Maybe ConstructType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IDType -> Maybe ConstructType
idCType))

recordEntryPoint :: Name -> Name -> Maybe Name -> Infer ()
recordEntryPoint :: Name -> Name -> Maybe Name -> StateT InferState Identity ()
recordEntryPoint Name
fn Name
en Maybe Name
mRetName = (InferState -> InferState) -> StateT InferState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InferState -> InferState) -> StateT InferState Identity ())
-> (InferState -> InferState) -> StateT InferState Identity ()
forall a b. (a -> b) -> a -> b
$ \ InferState
s -> InferState
s { entryPoints :: Map Name (Name, Maybe Name)
entryPoints = Name
-> (Name, Maybe Name)
-> Map Name (Name, Maybe Name)
-> Map Name (Name, Maybe Name)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
en (Name
fn, Maybe Name
mRetName) (InferState -> Map Name (Name, Maybe Name)
entryPoints InferState
s) }

getRecordedType :: Name -> Infer (Maybe IDType)
getRecordedType :: Name -> Infer (Maybe IDType)
getRecordedType Name
n = (InferState -> Maybe IDType) -> Infer (Maybe IDType)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Name -> TypeEnv -> Maybe IDType
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
n (TypeEnv -> Maybe IDType)
-> (InferState -> TypeEnv) -> InferState -> Maybe IDType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InferState -> TypeEnv
environ)

-- Set the idType annotation
setIDType :: Annotated f => IDType -> f (Analysis a) -> f (Analysis a)
setIDType :: IDType -> f (Analysis a) -> f (Analysis a)
setIDType IDType
ty f (Analysis a)
x
  | a :: Analysis a
a@Analysis {} <- f (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation f (Analysis a)
x = Analysis a -> f (Analysis a) -> f (Analysis a)
forall (f :: * -> *) a. Annotated f => a -> f a -> f a
setAnnotation (Analysis a
a { idType :: Maybe IDType
idType = IDType -> Maybe IDType
forall a. a -> Maybe a
Just IDType
ty }) f (Analysis a)
x
  | Bool
otherwise                          = f (Analysis a)
x

-- Get the idType annotation
getIDType :: (Annotated f, Data a) => f (Analysis a) -> Maybe IDType
getIDType :: f (Analysis a) -> Maybe IDType
getIDType f (Analysis a)
x = Analysis a -> Maybe IDType
forall a. Analysis a -> Maybe IDType
idType (f (Analysis a) -> Analysis a
forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation f (Analysis a)
x)

-- Set the CType part of idType annotation
--setCType :: (Annotated f, Data a) => ConstructType -> f (Analysis a) -> f (Analysis a)
--setCType ct x
--  | a@(Analysis { idType = Nothing }) <- getAnnotation x = setAnnotation (a { idType = Just (IDType Nothing (Just ct)) }) x
--  | a@(Analysis { idType = Just it }) <- getAnnotation x = setAnnotation (a { idType = Just (it { idCType = Just ct }) }) x

type UniFunc f g a = f (Analysis a) -> [g (Analysis a)]

allProgramUnits :: Data a => UniFunc ProgramFile ProgramUnit a
allProgramUnits :: UniFunc ProgramFile ProgramUnit a
allProgramUnits = UniFunc ProgramFile ProgramUnit a
forall from to. Biplate from to => from -> [to]
universeBi

allDeclarators :: Data a => UniFunc ProgramFile Declarator a
allDeclarators :: UniFunc ProgramFile Declarator a
allDeclarators = UniFunc ProgramFile Declarator a
forall from to. Biplate from to => from -> [to]
universeBi

allStatements :: (Data a, Data (f (Analysis a))) => UniFunc f Statement a
allStatements :: UniFunc f Statement a
allStatements = UniFunc f Statement a
forall from to. Biplate from to => from -> [to]
universeBi

allExpressions :: (Data a, Data (f (Analysis a))) => UniFunc f Expression a
allExpressions :: UniFunc f Expression a
allExpressions = UniFunc f Expression a
forall from to. Biplate from to => from -> [to]
universeBi

isAttrDimension :: Attribute a -> Bool
isAttrDimension :: Attribute a -> Bool
isAttrDimension AttrDimension {} = Bool
True
isAttrDimension Attribute a
_                = Bool
False

isAttrParameter :: Attribute a -> Bool
isAttrParameter :: Attribute a -> Bool
isAttrParameter AttrParameter {} = Bool
True
isAttrParameter Attribute a
_                  = Bool
False

isAttrExternal :: Attribute a -> Bool
isAttrExternal :: Attribute a -> Bool
isAttrExternal AttrExternal {} = Bool
True
isAttrExternal Attribute a
_                 = Bool
False

isIxSingle :: Index a -> Bool
isIxSingle :: Index a -> Bool
isIxSingle IxSingle {} = Bool
True
isIxSingle Index a
_             = Bool
False

--------------------------------------------------

-- Local variables:
-- mode: haskell
-- haskell-program-name: "cabal repl"
-- End: