{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

module Analyzer.Analyzer where

import qualified Analyzer.AnalyzedAst as AAst
import qualified Analyzer.AnalyzedType as AType
import Analyzer.ConstExpressionConverters (simplifyConstExpr, simplifyConstIntExpr)
import qualified Analyzer.ConstExpressionConverters as CEC
import Analyzer.Result
import Analyzer.Runtime (addNewVar, addOrUpdateVar, getCurrScopeType, getTypeDefault, getVarType, popScope, pushScope)
import Control.Lens (Field2 (_2), (%~))
import Control.Monad (mapAndUnzipM, void, when, (>=>))
import Control.Monad.Except (MonadError (throwError), liftEither, runExceptT)
import Control.Monad.State (gets, modify, runState)
import Data.Either.Extra (mapLeft)
import Data.Functor (($>))
import Data.List.Extra (find, nubOrd, (\\))
import Data.Maybe (isNothing, listToMaybe)
import Data.Text (Text)
import MaybeVoid (MaybeVoid (..), maybeVoid)
import qualified Parser.Ast as Ast
import qualified StdLib

--------------------------------------------------------Analyzer--------------------------------------------------------

-- * Analyzer

-- | Analyzer entry point
analyze :: Ast.Program -> (ResultValue AAst.Program, Env)
analyze :: Program -> (ResultValue Program, Env)
analyze Program
ast = forall s a. State s a -> s -> (a, s)
runState (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Program -> Result Program
analyzeProgram Program
ast)) Env
emptyEnv

-------------------------------------------------Program and functions--------------------------------------------------

analyzeProgram :: Ast.Program -> Result AAst.Program
analyzeProgram :: Program -> Result Program
analyzeProgram (Ast.Program [VarDecl]
tlVarDecls [FunctionDef]
tlFuncDefs) = do
  [Identifier] -> Result ()
checkForUniqueness forall a b. (a -> b) -> a -> b
$ (FunctionDef -> Identifier
Ast.funcName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FunctionDef]
tlFuncDefs) forall a. Semigroup a => a -> a -> a
<> (VarDecl -> Identifier
Ast.varName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarDecl]
tlVarDecls)
  [FunctionDef] -> Result ()
checkForMain [FunctionDef]
tlFuncDefs

  ([VarDecl]
vs, [(Identifier, Type)]
vsKVPs) <- [VarDecl] -> Result ([VarDecl], [(Identifier, Type)])
analyzeTLVarDecls [VarDecl]
tlVarDecls
  [FunctionDef]
funcs <- [(Identifier, Type)] -> [FunctionDef] -> Result [FunctionDef]
analyzeTLFuncDefs [(Identifier, Type)]
vsKVPs [FunctionDef]
tlFuncDefs

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [VarDecl] -> [FunctionDef] -> Program
AAst.Program [VarDecl]
vs [FunctionDef]
funcs
  where
    checkForUniqueness :: [Text] -> Result ()
    checkForUniqueness :: [Identifier] -> Result ()
checkForUniqueness [Identifier]
ns = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Err
IdentifierRedeclaration) (forall a. Ord a => [a] -> Maybe a
findDuplicate [Identifier]
ns)

    findDuplicate :: Ord a => [a] -> Maybe a
    findDuplicate :: forall a. Ord a => [a] -> Maybe a
findDuplicate [a]
list = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ [a]
list forall a. Eq a => [a] -> [a] -> [a]
\\ forall a. Ord a => [a] -> [a]
nubOrd [a]
list

    checkForMain :: [Ast.FunctionDef] -> Result ()
    checkForMain :: [FunctionDef] -> Result ()
checkForMain [FunctionDef]
funcs = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find FunctionDef -> Bool
predicate [FunctionDef]
funcs) (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
NoMain)
    predicate :: FunctionDef -> Bool
predicate (Ast.FunctionDef Identifier
name (Ast.Function [(Identifier, Type)]
params MaybeVoid Type
ret Block
_)) =
      Identifier
name forall a. Eq a => a -> a -> Bool
== Identifier
"main" Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Identifier, Type)]
params Bool -> Bool -> Bool
&& case MaybeVoid Type
ret of NonVoid Type
_ -> Bool
False; MaybeVoid Type
_ -> Bool
True

analyzeTLVarDecls :: [Ast.VarDecl] -> Result ([AAst.VarDecl], [(AAst.Identifier, AType.Type)])
analyzeTLVarDecls :: [VarDecl] -> Result ([VarDecl], [(Identifier, Type)])
analyzeTLVarDecls = forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM VarDecl -> ExceptT Err (State Env) (VarDecl, (Identifier, Type))
convertVarDecl
  where
    convertVarDecl :: VarDecl -> ExceptT Err (State Env) (VarDecl, (Identifier, Type))
convertVarDecl (Ast.VarDecl Identifier
name VarValue
val) = do
      (Type
t, Expression
expr) <- VarValue -> Result (Type, Expression)
analyzeVarValue VarValue
val
      forall (m :: * -> *) a. Monad m => a -> m a
return (Identifier -> Expression -> VarDecl
AAst.VarDecl Identifier
name Expression
expr, (Identifier
name, Type
t))

analyzeTLFuncDefs :: [(AAst.Identifier, AType.Type)] -> [Ast.FunctionDef] -> Result [AAst.FunctionDef]
analyzeTLFuncDefs :: [(Identifier, Type)] -> [FunctionDef] -> Result [FunctionDef]
analyzeTLFuncDefs [(Identifier, Type)]
varsKeyValuePairs [FunctionDef]
functionDefinitions = do
  [(Identifier, Type)]
funcsKeyValuePairs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FunctionDef -> ExceptT Err (State Env) (Identifier, Type)
convertFuncDef [FunctionDef]
functionDefinitions
  let initScope :: Scope
initScope = ScopeType -> [(Identifier, Type)] -> Scope
scope ScopeType
OrdinaryScope ([(Identifier, Type)]
varsKeyValuePairs forall a. Semigroup a => a -> a -> a
<> [(Identifier, Type)]
funcsKeyValuePairs)
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ Iso' Env [Scope]
scopes forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Scope
initScope forall a. a -> [a] -> [a]
:)
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FunctionDef -> ExceptT Err (State Env) FunctionDef
analyzeFuncDef [FunctionDef]
functionDefinitions
  where
    analyzeFuncDef :: FunctionDef -> ExceptT Err (State Env) FunctionDef
analyzeFuncDef (Ast.FunctionDef Identifier
name Function
func) = Identifier -> Function -> FunctionDef
AAst.FunctionDef Identifier
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Function -> Result (FunctionType, Function)
analyzeFunc Function
func)

    convertFuncDef :: FunctionDef -> ExceptT Err (State Env) (Identifier, Type)
convertFuncDef (Ast.FunctionDef Identifier
name (Ast.Function [(Identifier, Type)]
params MaybeVoid Type
ret Block
_)) = do
      [Type]
params' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Result Type
analyzeType (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Identifier, Type)]
params)
      MaybeVoid Type
ret' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Result Type
analyzeType MaybeVoid Type
ret
      forall (m :: * -> *) a. Monad m => a -> m a
return (Identifier
name, FunctionType -> Type
AType.TFunction forall a b. (a -> b) -> a -> b
$ [Type] -> MaybeVoid Type -> FunctionType
AType.FunctionType [Type]
params' MaybeVoid Type
ret')

analyzeFunc :: Ast.Function -> Result (AType.FunctionType, AAst.Function)
analyzeFunc :: Function -> Result (FunctionType, Function)
analyzeFunc (Ast.Function [(Identifier, Type)]
params MaybeVoid Type
ret Block
stmts) = do
  let paramsNs :: [Identifier]
paramsNs = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Identifier, Type)]
params
  [Type]
paramsTs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Type -> Result Type
analyzeType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Identifier, Type)]
params
  MaybeVoid Type
ret' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Result Type
analyzeType MaybeVoid Type
ret
  Block
stmts' <- Scope -> Block -> MaybeVoid Type -> Result Block
analyzeBlock (ScopeType -> [(Identifier, Type)] -> Scope
scope ScopeType
OrdinaryScope ([Identifier]
paramsNs forall a b. [a] -> [b] -> [(a, b)]
`zip` [Type]
paramsTs)) Block
stmts MaybeVoid Type
ret'
  forall (m :: * -> *) a. Monad m => a -> m a
return
    ( [Type] -> MaybeVoid Type -> FunctionType
AType.FunctionType [Type]
paramsTs MaybeVoid Type
ret',
      OrdinaryFunction -> Function
AAst.FuncOrdinary forall a b. (a -> b) -> a -> b
$ [Identifier] -> Block -> VoidMark -> OrdinaryFunction
AAst.OrdinaryFunction [Identifier]
paramsNs Block
stmts' forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> MaybeVoid a -> b
maybeVoid VoidMark
AAst.VoidFunc (forall a b. a -> b -> a
const VoidMark
AAst.NonVoidFunc) MaybeVoid Type
ret'
    )

-------------------------------------------------------Statements-------------------------------------------------------

-- | Analyze statement.
analyzeStmt :: Ast.Statement -> MaybeVoid AType.Type -> Result AAst.Statement
analyzeStmt :: Statement -> MaybeVoid Type -> Result Statement
analyzeStmt Statement
statement MaybeVoid Type
funcReturn = case Statement
statement of
  Ast.StmtReturn MaybeVoid Expression
expr -> MaybeVoid Expression -> MaybeVoid Type -> Result Statement
analyzeStmtReturn MaybeVoid Expression
expr MaybeVoid Type
funcReturn
  Ast.StmtForGoTo ForGoTo
goto -> ForGoTo -> Result Statement
analyzeStmtForGoTo ForGoTo
goto
  Ast.StmtFor For
for -> For -> MaybeVoid Type -> Result Statement
analyzeStmtFor For
for MaybeVoid Type
funcReturn
  Ast.StmtVarDecl VarDecl
varDecl -> VarDecl -> Statement
AAst.StmtVarDecl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VarDecl -> Result VarDecl
analyzeStmtVarDecl VarDecl
varDecl
  Ast.StmtIfElse IfElse
ifElse -> IfElse -> Statement
AAst.StmtIfElse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfElse -> MaybeVoid Type -> Result IfElse
analyzeIfElse IfElse
ifElse MaybeVoid Type
funcReturn
  Ast.StmtBlock Block
stmts -> Block -> Statement
AAst.StmtBlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block -> MaybeVoid Type -> Result Block
analyzeBlock' Block
stmts MaybeVoid Type
funcReturn
  Ast.StmtSimple SimpleStmt
simpleStmt -> SimpleStmt -> Statement
AAst.StmtSimple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleStmt -> Result SimpleStmt
analyzeSimpleStmt SimpleStmt
simpleStmt

analyzeStmtReturn :: MaybeVoid Ast.Expression -> MaybeVoid AType.Type -> Result AAst.Statement
analyzeStmtReturn :: MaybeVoid Expression -> MaybeVoid Type -> Result Statement
analyzeStmtReturn MaybeVoid Expression
expression MaybeVoid Type
funcReturn = do
  (MaybeVoid Type
t, MaybeVoid Expression
expr) <- case MaybeVoid Expression
expression of
    NonVoid Expression
expr -> (forall s t a b. Field2 s t a b => Lens s t a b
_2 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. a -> MaybeVoid a
NonVoid) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression -> Result (MaybeVoid Type, Expression)
analyzeExpr Expression
expr
    MaybeVoid Expression
Void -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. MaybeVoid a
Void, forall a. MaybeVoid a
Void)
  forall a. Eq a => a -> a -> Result ()
checkEq MaybeVoid Type
t MaybeVoid Type
funcReturn
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MaybeVoid Expression -> Statement
AAst.StmtReturn MaybeVoid Expression
expr

analyzeStmtForGoTo :: Ast.ForGoTo -> Result AAst.Statement
analyzeStmtForGoTo :: ForGoTo -> Result Statement
analyzeStmtForGoTo ForGoTo
goto = do
  ScopeType
scopeT <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> ScopeType
getCurrScopeType
  case ScopeType
scopeT of
    ScopeType
ForScope -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ForGoTo -> Statement
AAst.StmtForGoTo ForGoTo
goto
    ScopeType
OrdinaryScope -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
BreakOrContinueOutsideOfForScope

analyzeStmtFor :: Ast.For -> MaybeVoid AType.Type -> Result AAst.Statement
analyzeStmtFor :: For -> MaybeVoid Type -> Result Statement
analyzeStmtFor (Ast.For (Ast.ForHead Maybe SimpleStmt
preStmt Maybe Expression
condition Maybe SimpleStmt
postStmt) Block
stmts) MaybeVoid Type
funcReturn = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ Scope -> Env -> Env
pushScope (ScopeType -> Scope
emptyScope ScopeType
OrdinaryScope)
  Maybe SimpleStmt
preStmt' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SimpleStmt -> Result SimpleStmt
analyzeSimpleStmt Maybe SimpleStmt
preStmt
  Maybe Expression
condition' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expression -> Result Expression
analyzeBoolExpr Maybe Expression
condition
  Maybe SimpleStmt
postStmt' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SimpleStmt -> Result SimpleStmt
analyzeSimpleStmt Maybe SimpleStmt
postStmt
  Block
stmts' <- Scope -> Block -> MaybeVoid Type -> Result Block
analyzeBlock (ScopeType -> Scope
emptyScope ScopeType
ForScope) Block
stmts MaybeVoid Type
funcReturn
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Env -> Env
popScope
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ For -> Statement
AAst.StmtFor forall a b. (a -> b) -> a -> b
$ ForHead -> Block -> For
AAst.For (Maybe SimpleStmt -> Maybe Expression -> Maybe SimpleStmt -> ForHead
AAst.ForHead Maybe SimpleStmt
preStmt' Maybe Expression
condition' Maybe SimpleStmt
postStmt') Block
stmts'

analyzeStmtVarDecl :: Ast.VarDecl -> Result AAst.VarDecl
analyzeStmtVarDecl :: VarDecl -> Result VarDecl
analyzeStmtVarDecl (Ast.VarDecl Identifier
name VarValue
val) = do
  (Type
t, Expression
e) <- VarValue -> Result (Type, Expression)
analyzeVarValue VarValue
val
  Identifier -> Type -> Result ()
addNewVar Identifier
name Type
t
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Identifier -> Expression -> VarDecl
AAst.VarDecl Identifier
name Expression
e

analyzeVarValue :: Ast.VarValue -> Result (AType.Type, AAst.Expression)
analyzeVarValue :: VarValue -> Result (Type, Expression)
analyzeVarValue = \case
  Ast.VarValue (Just Type
t) Expression
expr -> do
    (Type
t', Expression
expr') <- Expression -> Result (Type, Expression)
analyzeExpr' Expression
expr
    Type
t'' <- Type -> Result Type
analyzeType Type
t
    forall a. Eq a => a -> a -> Result ()
checkEq Type
t' Type
t''
    forall (m :: * -> *) a. Monad m => a -> m a
return (Type
t', Expression
expr')
  Ast.VarValue Maybe Type
Nothing Expression
expr -> do
    (Type
t, Expression
expr') <- Expression -> Result (Type, Expression)
analyzeExpr' Expression
expr
    forall (m :: * -> *) a. Monad m => a -> m a
return (Type
t, Expression
expr')
  Ast.DefaultedVarValue Type
t -> do
    Type
t' <- Type -> Result Type
analyzeType Type
t
    forall (m :: * -> *) a. Monad m => a -> m a
return (Type
t', Type -> Expression
getTypeDefault Type
t')

analyzeIfElse :: Ast.IfElse -> MaybeVoid AType.Type -> Result AAst.IfElse
analyzeIfElse :: IfElse -> MaybeVoid Type -> Result IfElse
analyzeIfElse (Ast.IfElse Maybe SimpleStmt
preStmt Expression
condition Block
stmts Else
elseStmt) MaybeVoid Type
funcReturn = do
  Maybe SimpleStmt
preStmt' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SimpleStmt -> Result SimpleStmt
analyzeSimpleStmt Maybe SimpleStmt
preStmt
  Expression
condition' <- Expression -> Result Expression
analyzeBoolExpr Expression
condition
  Block
stmts' <- Block -> MaybeVoid Type -> Result Block
analyzeBlock' Block
stmts MaybeVoid Type
funcReturn
  Else
elseStmt' <- case Else
elseStmt of
    Else
Ast.NoElse -> forall (m :: * -> *) a. Monad m => a -> m a
return Else
AAst.NoElse
    Ast.Else Block
elseStmt' -> Block -> Else
AAst.Else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block -> MaybeVoid Type -> Result Block
analyzeBlock' Block
elseStmt' MaybeVoid Type
funcReturn
    Ast.Elif IfElse
ifElse -> IfElse -> Else
AAst.Elif forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfElse -> MaybeVoid Type -> Result IfElse
analyzeIfElse IfElse
ifElse MaybeVoid Type
funcReturn
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe SimpleStmt -> Expression -> Block -> Else -> IfElse
AAst.IfElse Maybe SimpleStmt
preStmt' Expression
condition' Block
stmts' Else
elseStmt'

analyzeBlock :: Scope -> Ast.Block -> MaybeVoid AType.Type -> Result AAst.Block
analyzeBlock :: Scope -> Block -> MaybeVoid Type -> Result Block
analyzeBlock Scope
initScope Block
stmts MaybeVoid Type
ret = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ Scope -> Env -> Env
pushScope Scope
initScope
  Block
stmts' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Statement -> MaybeVoid Type -> Result Statement
`analyzeStmt` MaybeVoid Type
ret) Block
stmts
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Env -> Env
popScope
  forall (m :: * -> *) a. Monad m => a -> m a
return Block
stmts'

analyzeBlock' :: Ast.Block -> MaybeVoid AType.Type -> Result AAst.Block
analyzeBlock' :: Block -> MaybeVoid Type -> Result Block
analyzeBlock' = Scope -> Block -> MaybeVoid Type -> Result Block
analyzeBlock (ScopeType -> Scope
emptyScope ScopeType
OrdinaryScope)

analyzeSimpleStmt :: Ast.SimpleStmt -> Result AAst.SimpleStmt
analyzeSimpleStmt :: SimpleStmt -> Result SimpleStmt
analyzeSimpleStmt = \case
  Ast.StmtAssignment Lvalue
lval Expression
expr -> do
    (Type
lvalT, Lvalue
lval') <- Lvalue -> Result (Type, Lvalue)
analyzeLvalue Lvalue
lval
    (Type
t, Expression
expr') <- Expression -> Result (Type, Expression)
analyzeExpr' Expression
expr
    forall a. Eq a => a -> a -> Result ()
checkEq Type
lvalT Type
t
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Lvalue -> Expression -> SimpleStmt
AAst.StmtAssignment Lvalue
lval' Expression
expr'
  Ast.StmtIncDec Lvalue
lval IncDec
incDec -> do
    (Type
lvalT, Lvalue
lval') <- Lvalue -> Result (Type, Lvalue)
analyzeLvalue Lvalue
lval
    forall a. Eq a => a -> a -> Result ()
checkEq Type
lvalT Type
AType.TInt
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Lvalue -> IncDec -> SimpleStmt
AAst.StmtIncDec Lvalue
lval' IncDec
incDec
  Ast.StmtShortVarDecl Identifier
name Expression
expr -> do
    (Type
t, Expression
expr') <- Expression -> Result (Type, Expression)
analyzeExpr' Expression
expr
    Identifier -> Type -> Result ()
addOrUpdateVar Identifier
name Type
t
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Identifier -> Expression -> SimpleStmt
AAst.StmtShortVarDecl Identifier
name Expression
expr'
  Ast.StmtExpression Expression
expr -> Expression -> SimpleStmt
AAst.StmtExpression forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression -> Result (MaybeVoid Type, Expression)
analyzeExpr Expression
expr

analyzeLvalue :: Ast.Lvalue -> Result (AType.Type, AAst.Lvalue)
analyzeLvalue :: Lvalue -> Result (Type, Lvalue)
analyzeLvalue = \case
  Ast.LvalVar Identifier
name -> (,Identifier -> Lvalue
AAst.LvalVar Identifier
name) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> Result Type
getVarType Identifier
name
  Ast.LvalArrEl Identifier
name [Expression]
indexExprs -> do
    Type
varT <- Identifier -> Result Type
getVarType Identifier
name
    [Expression]
indexExprs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expression -> Result Expression
analyzeIntExpr [Expression]
indexExprs
    let calculatedType :: Maybe Type
calculatedType =
          let getArrayElementType :: Type -> a -> Maybe Type
getArrayElementType Type
t a
dimCnt = case Type
t of
                AType.TArray Type
t' Int
_ | a
dimCnt forall a. Ord a => a -> a -> Bool
> a
0 -> Type -> a -> Maybe Type
getArrayElementType Type
t' (a
dimCnt forall a. Num a => a -> a -> a
- a
1)
                Type
_ | a
dimCnt forall a. Eq a => a -> a -> Bool
== a
0 -> forall a. a -> Maybe a
Just Type
t
                Type
_ -> forall a. Maybe a
Nothing
           in forall {a}. (Ord a, Num a) => Type -> a -> Maybe Type
getArrayElementType Type
varT (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expression]
indexExprs)
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
MismatchedTypes) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Identifier -> [Expression] -> Lvalue
AAst.LvalArrEl Identifier
name [Expression]
indexExprs')) Maybe Type
calculatedType

------------------------------------------------------Expressions-------------------------------------------------------

analyzeExpr :: Ast.Expression -> Result (MaybeVoid AType.Type, AAst.Expression)
analyzeExpr :: Expression -> Result (MaybeVoid Type, Expression)
analyzeExpr Expression
expression = case Expression -> Either Err (MaybeVoid Type, Expression)
simplifyConstExpr Expression
expression of
  Right (MaybeVoid Type, Expression)
res -> forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeVoid Type, Expression)
res
  Left Err
CEC.MismatchedTypes -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
MismatchedTypes
  Left Err
CEC.DivisionByZero -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
DivisionByZero
  Left Err
CEC.NotInIntBounds -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
NotInIntBounds
  Left Err
CEC.NotConstExpr -> case Expression
expression of
    Ast.ExprValue Value
val -> Value -> Result (MaybeVoid Type, Expression)
analyzeExprValue Value
val
    Ast.ExprIdentifier Identifier
name -> Identifier -> Result (MaybeVoid Type, Expression)
analyzeExprIdentifier Identifier
name
    Ast.ExprUnaryOp UnaryOp
unOp Expression
expr -> UnaryOp -> Expression -> Result (MaybeVoid Type, Expression)
analyzeExprUnaryOp UnaryOp
unOp Expression
expr
    Ast.ExprBinaryOp BinaryOp
binOp Expression
lhs Expression
rhs -> BinaryOp
-> Expression -> Expression -> Result (MaybeVoid Type, Expression)
analyzeExprBinaryOp BinaryOp
binOp Expression
lhs Expression
rhs
    Ast.ExprFuncCall Expression
func [Expression]
args -> Expression -> [Expression] -> Result (MaybeVoid Type, Expression)
analyzeExprFuncCall Expression
func [Expression]
args
    Ast.ExprArrayAccessByIndex Expression
arr Expression
index -> Expression -> Expression -> Result (MaybeVoid Type, Expression)
analyzeExprArrayAccessByIndex Expression
arr Expression
index
    Ast.ExprLenFuncCall Expression
arg -> Expression -> Result (MaybeVoid Type, Expression)
analyzeExprLenFuncCall Expression
arg
    Ast.ExprPrintFuncCall [Expression]
args -> [Expression] -> Result (MaybeVoid Type, Expression)
analyzeExprPrintFuncCall [Expression]
args
    Ast.ExprPrintlnFuncCall [Expression]
args -> [Expression] -> Result (MaybeVoid Type, Expression)
analyzeExprPrintlnFuncCall [Expression]
args
    Ast.ExprPanicFuncCall Expression
arg -> Expression -> Result (MaybeVoid Type, Expression)
analyzeExprPanicFuncCall Expression
arg

analyzeExprValue :: Ast.Value -> Result (MaybeVoid AType.Type, AAst.Expression)
analyzeExprValue :: Value -> Result (MaybeVoid Type, Expression)
analyzeExprValue = \case
  Ast.ValInt Integer
v -> forall {m :: * -> *} {a}.
(Monad m, Integral a) =>
a -> m (MaybeVoid Type, Expression)
returnInt Integer
v
  Ast.ValBool Bool
v -> forall {m :: * -> *}.
Monad m =>
Bool -> m (MaybeVoid Type, Expression)
returnBool Bool
v
  Ast.ValString Identifier
v -> forall {m :: * -> *}.
Monad m =>
Identifier -> m (MaybeVoid Type, Expression)
returnString Identifier
v
  Ast.ValArray (Ast.ArrayValue ArrayType
t [Expression]
els) -> do
    (Type
elT, Int
len) <- ArrayType -> Result (Type, Int)
analyzeArrayType ArrayType
t
    ([Type]
elsTs, [Expression]
elsVs) <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM Expression -> Result (Type, Expression)
analyzeExpr' [Expression]
els
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a. Eq a => a -> a -> Result ()
checkEq Type
elT) [Type]
elsTs
    Bool -> Result ()
checkCondition forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expression]
elsVs forall a. Ord a => a -> a -> Bool
<= Int
len
    forall {m :: * -> *}.
Monad m =>
Type -> Int -> [Expression] -> m (MaybeVoid Type, Expression)
returnArray Type
elT Int
len [Expression]
elsVs
  Ast.ValFunction (Ast.AnonymousFunction Function
function) -> Function -> Result (FunctionType, Function)
analyzeFunc Function
function forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {m :: * -> *}.
Monad m =>
FunctionType -> Function -> m (MaybeVoid Type, Expression)
returnFunction
  Ast.ValFunction FunctionValue
Ast.Nil -> Result (MaybeVoid Type, Expression)
returnNil
  where
    returnInt :: a -> m (MaybeVoid Type, Expression)
returnInt a
v = forall {m :: * -> *} {a}.
Monad m =>
a -> Value -> m (MaybeVoid a, Expression)
return' Type
AType.TInt forall a b. (a -> b) -> a -> b
$ Int -> Value
AAst.ValInt forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v
    returnBool :: Bool -> m (MaybeVoid Type, Expression)
returnBool Bool
v = forall {m :: * -> *} {a}.
Monad m =>
a -> Value -> m (MaybeVoid a, Expression)
return' Type
AType.TBool forall a b. (a -> b) -> a -> b
$ Bool -> Value
AAst.ValBool Bool
v
    returnString :: Identifier -> m (MaybeVoid Type, Expression)
returnString Identifier
v = forall {m :: * -> *} {a}.
Monad m =>
a -> Value -> m (MaybeVoid a, Expression)
return' Type
AType.TString forall a b. (a -> b) -> a -> b
$ Identifier -> Value
AAst.ValString Identifier
v
    returnArray :: Type -> Int -> [Expression] -> m (MaybeVoid Type, Expression)
returnArray Type
elT Int
len [Expression]
elsVs =
      forall {m :: * -> *} {a}.
Monad m =>
a -> Value -> m (MaybeVoid a, Expression)
return' (Type -> Int -> Type
AType.TArray Type
elT Int
len) forall a b. (a -> b) -> a -> b
$ [Expression] -> Value
AAst.ValArray forall a b. (a -> b) -> a -> b
$ [Expression]
elsVs forall a. Semigroup a => a -> a -> a
<> forall a. Int -> a -> [a]
replicate (Int
len forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expression]
elsVs) (Type -> Expression
getTypeDefault Type
elT)
    returnFunction :: FunctionType -> Function -> m (MaybeVoid Type, Expression)
returnFunction FunctionType
t Function
f = forall {m :: * -> *} {a}.
Monad m =>
a -> Value -> m (MaybeVoid a, Expression)
return' (FunctionType -> Type
AType.TFunction FunctionType
t) forall a b. (a -> b) -> a -> b
$ FunctionValue -> Value
AAst.ValFunction (Function -> FunctionValue
AAst.Function Function
f)
    returnNil :: Result (MaybeVoid Type, Expression)
returnNil = forall {m :: * -> *} {a}.
Monad m =>
a -> Value -> m (MaybeVoid a, Expression)
return' Type
AType.TNil forall a b. (a -> b) -> a -> b
$ FunctionValue -> Value
AAst.ValFunction FunctionValue
AAst.Nil

    return' :: a -> Value -> m (MaybeVoid a, Expression)
return' a
t Value
expr = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> MaybeVoid a
NonVoid a
t, Value -> Expression
AAst.ExprValue Value
expr)

analyzeExprIdentifier :: AAst.Identifier -> Result (MaybeVoid AType.Type, AAst.Expression)
analyzeExprIdentifier :: Identifier -> Result (MaybeVoid Type, Expression)
analyzeExprIdentifier Identifier
name = (,Identifier -> Expression
AAst.ExprIdentifier Identifier
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> MaybeVoid a
NonVoid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> Result Type
getVarType Identifier
name

analyzeExprUnaryOp :: Ast.UnaryOp -> Ast.Expression -> Result (MaybeVoid AType.Type, AAst.Expression)
analyzeExprUnaryOp :: UnaryOp -> Expression -> Result (MaybeVoid Type, Expression)
analyzeExprUnaryOp UnaryOp
unOp Expression
expr = do
  (Type
t, Expression
expr') <- Expression -> Result (Type, Expression)
analyzeExpr' Expression
expr
  let return' :: Result (MaybeVoid Type, Expression)
return' = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> MaybeVoid a
NonVoid Type
t, UnaryOp -> Expression -> Expression
AAst.ExprUnaryOp UnaryOp
unOp Expression
expr')
  case (UnaryOp
unOp, Type
t) of
    (UnaryOp
Ast.UnaryPlusOp, Type
AType.TInt) -> Result (MaybeVoid Type, Expression)
return'
    (UnaryOp
Ast.UnaryMinusOp, Type
AType.TInt) -> Result (MaybeVoid Type, Expression)
return'
    (UnaryOp
Ast.NotOp, Type
AType.TBool) -> Result (MaybeVoid Type, Expression)
return'
    (UnaryOp, Type)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
MismatchedTypes

analyzeExprBinaryOp :: Ast.BinaryOp -> Ast.Expression -> Ast.Expression -> Result (MaybeVoid AType.Type, AAst.Expression)
analyzeExprBinaryOp :: BinaryOp
-> Expression -> Expression -> Result (MaybeVoid Type, Expression)
analyzeExprBinaryOp BinaryOp
binOp Expression
lhs Expression
rhs = do
  (Type
lhsT, Expression
lhs') <- Expression -> Result (Type, Expression)
analyzeExpr' Expression
lhs
  (Type
rhsT, Expression
rhs') <- Expression -> Result (Type, Expression)
analyzeExpr' Expression
rhs
  forall a. Eq a => a -> a -> Result ()
checkEq Type
lhsT Type
rhsT
  let return' :: a -> m (MaybeVoid a, Expression)
return' a
t = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> MaybeVoid a
NonVoid a
t, BinaryOp -> Expression -> Expression -> Expression
AAst.ExprBinaryOp BinaryOp
binOp Expression
lhs' Expression
rhs')
  let returnInt :: Result (MaybeVoid Type, Expression)
returnInt = forall {m :: * -> *} {a}.
Monad m =>
a -> m (MaybeVoid a, Expression)
return' Type
AType.TInt
  let returnBool :: Result (MaybeVoid Type, Expression)
returnBool = forall {m :: * -> *} {a}.
Monad m =>
a -> m (MaybeVoid a, Expression)
return' Type
AType.TBool
  let returnString :: Result (MaybeVoid Type, Expression)
returnString = forall {m :: * -> *} {a}.
Monad m =>
a -> m (MaybeVoid a, Expression)
return' Type
AType.TString
  case (BinaryOp
binOp, Type
lhsT) of
    (BinaryOp
Ast.OrOp, Type
AType.TBool) -> Result (MaybeVoid Type, Expression)
returnBool
    (BinaryOp
Ast.AndOp, Type
AType.TBool) -> Result (MaybeVoid Type, Expression)
returnBool
    (BinaryOp
Ast.EqOp, Type
_) -> Result (MaybeVoid Type, Expression)
returnBool
    (BinaryOp
Ast.NeOp, Type
_) -> Result (MaybeVoid Type, Expression)
returnBool
    (BinaryOp
Ast.LeOp, Type
AType.TInt) -> Result (MaybeVoid Type, Expression)
returnBool
    (BinaryOp
Ast.LtOp, Type
AType.TInt) -> Result (MaybeVoid Type, Expression)
returnBool
    (BinaryOp
Ast.MeOp, Type
AType.TInt) -> Result (MaybeVoid Type, Expression)
returnBool
    (BinaryOp
Ast.MtOp, Type
AType.TInt) -> Result (MaybeVoid Type, Expression)
returnBool
    (BinaryOp
Ast.LeOp, Type
AType.TString) -> Result (MaybeVoid Type, Expression)
returnBool
    (BinaryOp
Ast.LtOp, Type
AType.TString) -> Result (MaybeVoid Type, Expression)
returnBool
    (BinaryOp
Ast.MeOp, Type
AType.TString) -> Result (MaybeVoid Type, Expression)
returnBool
    (BinaryOp
Ast.MtOp, Type
AType.TString) -> Result (MaybeVoid Type, Expression)
returnBool
    (BinaryOp
Ast.PlusOp, Type
AType.TInt) -> Result (MaybeVoid Type, Expression)
returnInt
    (BinaryOp
Ast.PlusOp, Type
AType.TString) -> Result (MaybeVoid Type, Expression)
returnString
    (BinaryOp
Ast.MinusOp, Type
AType.TInt) -> Result (MaybeVoid Type, Expression)
returnInt
    (BinaryOp
Ast.MultOp, Type
AType.TInt) -> Result (MaybeVoid Type, Expression)
returnInt
    (BinaryOp
Ast.DivOp, Type
AType.TInt) -> Result (MaybeVoid Type, Expression)
returnInt
    (BinaryOp
Ast.ModOp, Type
AType.TInt) -> Result (MaybeVoid Type, Expression)
returnInt
    (BinaryOp, Type)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
MismatchedTypes

analyzeExprFuncCall :: Ast.Expression -> [Ast.Expression] -> Result (MaybeVoid AType.Type, AAst.Expression)
analyzeExprFuncCall :: Expression -> [Expression] -> Result (MaybeVoid Type, Expression)
analyzeExprFuncCall Expression
func [Expression]
args = do
  (Type
funcT, Expression
func') <- Expression -> Result (Type, Expression)
analyzeExpr' Expression
func
  case Type
funcT of
    (AType.TFunction (AType.FunctionType [Type]
paramsTs MaybeVoid Type
retT)) -> do
      ([Type]
argsTs, [Expression]
args') <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM Expression -> Result (Type, Expression)
analyzeExpr' [Expression]
args
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Eq a => a -> a -> Result ()
checkEq) ([Type]
paramsTs forall a b. [a] -> [b] -> [(a, b)]
`zip` [Type]
argsTs)
      forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeVoid Type
retT, Expression -> [Expression] -> Expression
AAst.ExprFuncCall Expression
func' [Expression]
args')
    Type
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
MismatchedTypes

analyzeExprArrayAccessByIndex :: Ast.Expression -> Ast.Expression -> Result (MaybeVoid AType.Type, AAst.Expression)
analyzeExprArrayAccessByIndex :: Expression -> Expression -> Result (MaybeVoid Type, Expression)
analyzeExprArrayAccessByIndex Expression
arr Expression
index = do
  (Type
aT, Expression
a) <- Expression -> Result (Type, Expression)
analyzeExpr' Expression
arr
  Expression
i <- Expression -> Result Expression
analyzeIntExpr Expression
index
  case Type
aT of
    AType.TArray Type
elT Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> MaybeVoid a
NonVoid Type
elT, Expression -> Expression -> Expression
AAst.ExprArrayAccessByIndex Expression
a Expression
i)
    Type
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
MismatchedTypes

analyzeExprLenFuncCall :: Ast.Expression -> Result (MaybeVoid AType.Type, AAst.Expression)
analyzeExprLenFuncCall :: Expression -> Result (MaybeVoid Type, Expression)
analyzeExprLenFuncCall Expression
arg = do
  (Type
argT, Expression
argE) <- Expression -> Result (Type, Expression)
analyzeExpr' Expression
arg
  let return' :: Result (MaybeVoid Type, Expression)
return' = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> MaybeVoid a
NonVoid Type
AType.TInt, Expression -> [Expression] -> Expression
AAst.ExprFuncCall (Identifier -> Expression
stdLibFuncExpr forall a b. (a -> b) -> a -> b
$ StdLibFunction -> Identifier
StdLib.name StdLibFunction
StdLib.lenFunction) [Expression
argE])
  case Type
argT of
    Type
AType.TString -> Result (MaybeVoid Type, Expression)
return'
    AType.TArray Type
_ Int
_ -> Result (MaybeVoid Type, Expression)
return'
    Type
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
MismatchedTypes

analyzeExprPrintFuncCall :: [Ast.Expression] -> Result (MaybeVoid AType.Type, AAst.Expression)
analyzeExprPrintFuncCall :: [Expression] -> Result (MaybeVoid Type, Expression)
analyzeExprPrintFuncCall [Expression]
args =
  (\[Expression]
args' -> (forall a. MaybeVoid a
Void, Expression -> [Expression] -> Expression
AAst.ExprFuncCall (Identifier -> Expression
stdLibFuncExpr forall a b. (a -> b) -> a -> b
$ StdLibFunction -> Identifier
StdLib.name StdLibFunction
StdLib.printFunction) [Expression]
args'))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression -> Result (MaybeVoid Type, Expression)
analyzeExpr) [Expression]
args

analyzeExprPrintlnFuncCall :: [Ast.Expression] -> Result (MaybeVoid AType.Type, AAst.Expression)
analyzeExprPrintlnFuncCall :: [Expression] -> Result (MaybeVoid Type, Expression)
analyzeExprPrintlnFuncCall [Expression]
args =
  (\[Expression]
args' -> (forall a. MaybeVoid a
Void, Expression -> [Expression] -> Expression
AAst.ExprFuncCall (Identifier -> Expression
stdLibFuncExpr forall a b. (a -> b) -> a -> b
$ StdLibFunction -> Identifier
StdLib.name StdLibFunction
StdLib.printlnFunction) [Expression]
args'))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression -> Result (MaybeVoid Type, Expression)
analyzeExpr) [Expression]
args

analyzeExprPanicFuncCall :: Ast.Expression -> Result (MaybeVoid AType.Type, AAst.Expression)
analyzeExprPanicFuncCall :: Expression -> Result (MaybeVoid Type, Expression)
analyzeExprPanicFuncCall Expression
arg = do
  (MaybeVoid Type
argT, Expression
argE) <- Expression -> Result (MaybeVoid Type, Expression)
analyzeExpr Expression
arg
  forall a. Eq a => a -> a -> Result ()
checkEq (forall a. a -> MaybeVoid a
NonVoid Type
AType.TString) MaybeVoid Type
argT
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. MaybeVoid a
Void, Expression -> [Expression] -> Expression
AAst.ExprFuncCall (Identifier -> Expression
stdLibFuncExpr forall a b. (a -> b) -> a -> b
$ StdLibFunction -> Identifier
StdLib.name StdLibFunction
StdLib.panicFunction) [Expression
argE])

---------------------------------------------------------Types----------------------------------------------------------

analyzeType :: Ast.Type -> Result AType.Type
analyzeType :: Type -> Result Type
analyzeType = \case
  Type
Ast.TInt -> forall (m :: * -> *) a. Monad m => a -> m a
return Type
AType.TInt
  Type
Ast.TBool -> forall (m :: * -> *) a. Monad m => a -> m a
return Type
AType.TBool
  Type
Ast.TString -> forall (m :: * -> *) a. Monad m => a -> m a
return Type
AType.TString
  Ast.TArray ArrayType
arrType -> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Type -> Int -> Type
AType.TArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArrayType -> Result (Type, Int)
analyzeArrayType ArrayType
arrType
  Ast.TFunction FunctionType
funcType -> FunctionType -> Type
AType.TFunction forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FunctionType -> Result FunctionType
analyzeFunctionType FunctionType
funcType

analyzeArrayType :: Ast.ArrayType -> Result (AType.Type, Int)
analyzeArrayType :: ArrayType -> Result (Type, Int)
analyzeArrayType (Ast.ArrayType Type
elementT Expression
len) =
  (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Result Type
analyzeType Type
elementT forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Either Err a -> Result a
liftCEC (Expression -> Either Err Int
simplifyConstIntExpr Expression
len)

analyzeFunctionType :: Ast.FunctionType -> Result AType.FunctionType
analyzeFunctionType :: FunctionType -> Result FunctionType
analyzeFunctionType (Ast.FunctionType [Type]
paramsTs MaybeVoid Type
retT) =
  [Type] -> MaybeVoid Type -> FunctionType
AType.FunctionType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Result Type
analyzeType [Type]
paramsTs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Result Type
analyzeType MaybeVoid Type
retT

---------------------------------------------------------Utils----------------------------------------------------------

analyzeExpr' :: Ast.Expression -> Result (AType.Type, AAst.Expression)
analyzeExpr' :: Expression -> Result (Type, Expression)
analyzeExpr' = Expression -> Result (MaybeVoid Type, Expression)
analyzeExpr forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (MaybeVoid Type, Expression) -> Result (Type, Expression)
unwrapExprRes

analyzeIntExpr :: Ast.Expression -> Result AAst.Expression
analyzeIntExpr :: Expression -> Result Expression
analyzeIntExpr = Expression -> Result (Type, Expression)
analyzeExpr' forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\(Type
t, Expression
expr) -> forall a. Eq a => a -> a -> Result ()
checkEq Type
AType.TInt Type
t forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Expression
expr)

analyzeBoolExpr :: Ast.Expression -> Result AAst.Expression
analyzeBoolExpr :: Expression -> Result Expression
analyzeBoolExpr = Expression -> Result (Type, Expression)
analyzeExpr' forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\(Type
t, Expression
expr) -> forall a. Eq a => a -> a -> Result ()
checkEq Type
AType.TBool Type
t forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Expression
expr)

stdLibFuncExpr :: AAst.Identifier -> AAst.Expression
stdLibFuncExpr :: Identifier -> Expression
stdLibFuncExpr = Value -> Expression
AAst.ExprValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionValue -> Value
AAst.ValFunction forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> FunctionValue
AAst.Function forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Function
AAst.FuncStdLib

checkEq :: Eq a => a -> a -> Result ()
checkEq :: forall a. Eq a => a -> a -> Result ()
checkEq a
lhs a
rhs = Bool -> Result ()
checkCondition forall a b. (a -> b) -> a -> b
$ a
lhs forall a. Eq a => a -> a -> Bool
== a
rhs

checkCondition :: Bool -> Result ()
checkCondition :: Bool -> Result ()
checkCondition Bool
cond = if Bool
cond then forall (m :: * -> *) a. Monad m => a -> m a
return () else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
MismatchedTypes

unwrapMaybeVoid :: MaybeVoid a -> Result a
unwrapMaybeVoid :: forall a. MaybeVoid a -> Result a
unwrapMaybeVoid = \case
  NonVoid a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  MaybeVoid a
Void -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
MismatchedTypes

unwrapExprRes :: (MaybeVoid AType.Type, AAst.Expression) -> Result (AType.Type, AAst.Expression)
unwrapExprRes :: (MaybeVoid Type, Expression) -> Result (Type, Expression)
unwrapExprRes (MaybeVoid Type
t, Expression
expr) = (,Expression
expr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. MaybeVoid a -> Result a
unwrapMaybeVoid MaybeVoid Type
t

liftCEC :: Either CEC.Err a -> Result a
liftCEC :: forall a. Either Err a -> Result a
liftCEC Either Err a
cecRes = forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Err -> Err
mapErr Either Err a
cecRes)
  where
    mapErr :: Err -> Err
mapErr = \case
      Err
CEC.MismatchedTypes -> Err
MismatchedTypes
      Err
CEC.DivisionByZero -> Err
DivisionByZero
      Err
CEC.NotInIntBounds -> Err
NotInIntBounds
      Err
CEC.NotConstExpr -> Err
MismatchedTypes