Determine an expression type

TODO

@@ -1 +1,4 @@
 # Type analysis
+
+- Iterate the tree and apply the expression function on procedure expressions.
+- Check statement types.

elna.cabal

@@ -22,6 +22,7 @@ common warnings
     ghc-options: -Wall
     default-extensions:
         ExplicitForAll,
+        LambdaCase,
         OverloadedStrings
     default-language: GHC2021
 

lib/Language/Elna/TypeAnalysis.hs

@@ -3,12 +3,24 @@ module Language.Elna.TypeAnalysis
     , typeAnalysis
     ) where
 
-import Control.Monad.Trans.Except (Except, runExcept)
-import Control.Monad.Trans.Reader (ReaderT, runReaderT)
+import Control.Applicative (Alternative(..))
+import Control.Monad.Trans.Except (Except, runExcept, throwE)
+import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT)
 import qualified Language.Elna.AST as AST
-import Language.Elna.SymbolTable (SymbolTable)
+import Language.Elna.Location (Identifier(..))
+import Language.Elna.SymbolTable (Info(..), SymbolTable)
+import qualified Language.Elna.SymbolTable as SymbolTable
+import Language.Elna.Types (Type(..), booleanType, intType)
+import Control.Monad.Trans.Class (MonadTrans(..))
+import Control.Monad (unless)
 
-data Error = Error
+data Error
+    = ArithmeticExpressionError Type
+    | ComparisonExpressionError Type Type
+    | UnexpectedVariableInfoError Info
+    | UndefinedSymbolError Identifier
+    | ArrayIndexError Type
+    | ArrayAccessError Type
     deriving (Eq, Show)
 
 newtype TypeAnalysis a = TypeAnalysis
@@ -37,3 +49,60 @@ typeAnalysis globalTable = either Just (const Nothing)
 
 program :: AST.Program -> TypeAnalysis ()
 program (AST.Program _declarations) = pure ()
+
+expression :: SymbolTable -> AST.Expression -> TypeAnalysis Type
+expression globalTable = \case
+    AST.VariableExpression identifier -> do
+        localLookup <- TypeAnalysis $ asks $ SymbolTable.lookup identifier
+        case localLookup <|> SymbolTable.lookup identifier globalTable of
+            Just (VariableInfo variableType _) -> pure variableType
+            Just anotherInfo -> TypeAnalysis $ lift $ throwE
+                $ UnexpectedVariableInfoError anotherInfo
+            Nothing -> TypeAnalysis $ lift $ throwE
+                $ UndefinedSymbolError identifier
+    AST.LiteralExpression literal' -> literal literal'
+    AST.NegationExpression negation -> do
+        operandType <- expression globalTable negation
+        if operandType == intType
+        then pure intType
+        else TypeAnalysis $ lift $ throwE $ ArithmeticExpressionError operandType
+    AST.SumExpression lhs rhs -> arithmeticExpression lhs rhs
+    AST.SubtractionExpression lhs rhs -> arithmeticExpression lhs rhs
+    AST.ProductExpression lhs rhs -> arithmeticExpression lhs rhs
+    AST.DivisionExpression lhs rhs -> arithmeticExpression lhs rhs
+    AST.EqualExpression lhs rhs -> comparisonExpression lhs rhs
+    AST.NonEqualExpression lhs rhs -> comparisonExpression lhs rhs
+    AST.LessExpression lhs rhs -> comparisonExpression lhs rhs
+    AST.GreaterExpression lhs rhs -> comparisonExpression lhs rhs
+    AST.LessOrEqualExpression lhs rhs -> comparisonExpression lhs rhs
+    AST.GreaterOrEqualExpression lhs rhs -> comparisonExpression lhs rhs
+    AST.ArrayExpression arrayExpression indexExpression -> do
+        arrayType <- expression globalTable arrayExpression
+        indexType <- expression globalTable indexExpression
+        unless (indexType == intType)
+            $ TypeAnalysis $ lift $ throwE $ ArrayIndexError indexType
+        case arrayType of
+            ArrayType _ baseType -> pure baseType
+            nonArrayType -> TypeAnalysis $ lift $ throwE
+                $ ArrayAccessError nonArrayType
+  where
+    arithmeticExpression lhs rhs = do
+        lhsType <- expression globalTable lhs
+        unless (lhsType == intType)
+            $ TypeAnalysis $ lift $ throwE $ ArithmeticExpressionError lhsType
+        rhsType <- expression globalTable rhs
+        unless (rhsType == intType)
+            $ TypeAnalysis $ lift $ throwE $ ArithmeticExpressionError rhsType
+        pure intType
+    comparisonExpression lhs rhs = do
+        lhsType <- expression globalTable lhs
+        rhsType <- expression globalTable rhs
+        if lhsType == intType && rhsType ==intType
+        then pure booleanType
+        else TypeAnalysis $ lift $ throwE $ ComparisonExpressionError lhsType rhsType
+
+literal :: AST.Literal -> TypeAnalysis Type
+literal (AST.IntegerLiteral _) = pure intType
+literal (AST.HexadecimalLiteral _) = pure intType
+literal (AST.CharacterLiteral _) = pure intType
+literal (AST.BooleanLiteral _) = pure booleanType