From 385322235ddabde3a2d5f33d8f258016a9170f83 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Tue, 6 Aug 2024 17:02:18 +0200
Subject: Look for undefined symbols

---
 lib/Language/Elna/NameAnalysis.hs | 84 +++++++++++++++++++++++++++++++++++++--
 1 file changed, 80 insertions(+), 4 deletions(-)

(limited to 'lib/Language/Elna/NameAnalysis.hs')

diff --git a/lib/Language/Elna/NameAnalysis.hs b/lib/Language/Elna/NameAnalysis.hs
index afb040e..57c41b3 100644
--- a/lib/Language/Elna/NameAnalysis.hs
+++ b/lib/Language/Elna/NameAnalysis.hs
@@ -4,7 +4,13 @@ module Language.Elna.NameAnalysis
     ) where
 
 import Control.Monad.Trans.Except (Except, runExcept, throwE)
-import Control.Monad.Trans.Reader (ReaderT(..), ask, runReaderT, withReaderT)
+import Control.Monad.Trans.Reader
+    ( ReaderT(..)
+    , ask
+    , asks
+    , runReaderT
+    , withReaderT
+    )
 import Data.Functor ((<&>))
 import qualified Language.Elna.AST as AST
 import Language.Elna.Location (Identifier(..))
@@ -12,13 +18,15 @@ import Language.Elna.SymbolTable (Info(..), SymbolTable, builtInSymbolTable)
 import qualified Language.Elna.SymbolTable as SymbolTable
 import Language.Elna.Types (Type(..))
 import Control.Monad.Trans.Class (MonadTrans(..))
-import Control.Monad (foldM)
+import Control.Monad (foldM, unless)
 import qualified Data.List.NonEmpty as NonEmpty
+import Data.Foldable (traverse_)
 
 data Error
     = UndefinedTypeError Identifier
     | UnexpectedTypeInfoError Info
     | IdentifierAlreadyDefinedError Identifier
+    | UndefinedSymbolError Identifier
     deriving (Eq, Show)
 
 newtype NameAnalysis a = NameAnalysis
@@ -53,15 +61,83 @@ declaration :: SymbolTable -> AST.Declaration -> NameAnalysis SymbolTable
 declaration globalTable (AST.TypeDefinition identifier typeExpression)
     = withSymbolTable globalTable (dataType typeExpression)
     >>= flip (enter identifier) globalTable . TypeInfo
-    
-declaration globalTable (AST.ProcedureDefinition identifier parameters variables _body) = do
+declaration globalTable (AST.ProcedureDefinition identifier parameters variables body) = do
         parametersInfo <- mapM parameter parameters
         variableInfo <- mapM variableDeclaration variables
         newTable <- either (identifierAlreadyDefinedError . NonEmpty.head) pure
             $ SymbolTable.fromList
             $ parametersInfo <> variableInfo
+        traverse_ (statement globalTable) body
         enter identifier (ProcedureInfo newTable mempty) globalTable
 
+statement :: SymbolTable -> AST.Statement -> NameAnalysis ()
+statement _ AST.EmptyStatement = pure ()
+statement globalTable (AST.AssignmentStatement lvalue rvalue)
+    = expression globalTable lvalue
+    >> expression globalTable rvalue
+statement globalTable (AST.IfStatement condition ifStatement elseStatement)
+    = expression globalTable condition
+    >> statement globalTable ifStatement
+    >> maybe (pure ()) (statement globalTable) elseStatement
+statement globalTable (AST.WhileStatement condition loop)
+    = expression globalTable condition
+    >> statement globalTable loop
+statement globalTable (AST.CompoundStatement statements) =
+    traverse_ (statement globalTable) statements
+statement globalTable (AST.CallStatement name arguments)
+    = checkSymbol name globalTable
+    >> traverse_ (expression globalTable) arguments
+
+checkSymbol :: Identifier -> SymbolTable -> NameAnalysis ()
+checkSymbol identifier globalTable =
+    let undefinedSymbolError = NameAnalysis
+            $ lift
+            $ throwE
+            $ UndefinedSymbolError identifier
+        isDefined = SymbolTable.member identifier globalTable
+     in NameAnalysis (asks (SymbolTable.member identifier))
+        >>= (flip unless undefinedSymbolError . (isDefined ||))
+
+expression :: SymbolTable -> AST.Expression -> NameAnalysis ()
+expression globalTable (AST.VariableExpression identifier) =
+    checkSymbol identifier globalTable
+expression _ (AST.LiteralExpression _) = pure ()
+expression globalTable (AST.NegationExpression negation) =
+    expression globalTable negation
+expression globalTable (AST.SumExpression lhs rhs)
+    = expression globalTable lhs
+    >> expression globalTable rhs
+expression globalTable (AST.SubtractionExpression lhs rhs)
+    = expression globalTable lhs
+    >> expression globalTable rhs
+expression globalTable (AST.ProductExpression lhs rhs)
+    = expression globalTable lhs
+    >> expression globalTable rhs
+expression globalTable (AST.DivisionExpression lhs rhs)
+    = expression globalTable lhs
+    >> expression globalTable rhs
+expression globalTable (AST.EqualExpression lhs rhs)
+    = expression globalTable lhs
+    >> expression globalTable rhs
+expression globalTable (AST.NonEqualExpression lhs rhs)
+    = expression globalTable lhs
+    >> expression globalTable rhs
+expression globalTable (AST.LessExpression lhs rhs)
+    = expression globalTable lhs
+    >> expression globalTable rhs
+expression globalTable (AST.GreaterExpression lhs rhs)
+    = expression globalTable lhs
+    >> expression globalTable rhs
+expression globalTable (AST.LessOrEqualExpression lhs rhs)
+    = expression globalTable lhs
+    >> expression globalTable rhs
+expression globalTable (AST.GreaterOrEqualExpression lhs rhs)
+    = expression globalTable lhs
+    >> expression globalTable rhs
+expression globalTable (AST.ArrayExpression arrayExpression indexExpression)
+    = expression globalTable arrayExpression
+    >> expression globalTable indexExpression
+
 enter :: Identifier -> Info -> SymbolTable -> NameAnalysis SymbolTable
 enter identifier info table
     = maybe (identifierAlreadyDefinedError identifier) pure
-- 
cgit v1.2.3