From 573990551cd19cba3959579910781637e0d9ecb4 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Wed, 7 Aug 2024 22:47:35 +0200
Subject: [PATCH] Determine an expression type

---
 TODO                              |  3 ++
 elna.cabal                        |  1 +
 lib/Language/Elna/TypeAnalysis.hs | 77 +++++++++++++++++++++++++++++--
 3 files changed, 77 insertions(+), 4 deletions(-)

diff --git a/TODO b/TODO
index 9862022..6a2f85b 100644
--- a/TODO
+++ b/TODO
@@ -1 +1,4 @@
 # Type analysis
+
+- Iterate the tree and apply the expression function on procedure expressions.
+- Check statement types.
diff --git a/elna.cabal b/elna.cabal
index 6ca8912..564e108 100644
--- a/elna.cabal
+++ b/elna.cabal
@@ -22,6 +22,7 @@ common warnings
     ghc-options: -Wall
     default-extensions:
         ExplicitForAll,
+        LambdaCase,
         OverloadedStrings
     default-language: GHC2021
 
diff --git a/lib/Language/Elna/TypeAnalysis.hs b/lib/Language/Elna/TypeAnalysis.hs
index 9804753..0cc60a2 100644
--- a/lib/Language/Elna/TypeAnalysis.hs
+++ b/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