Look for undefined symbols

TODO

@@ -1,3 +1 @@
-# Name analysis
+# Type analysis
-
-- Ensure type, procedure, variable and parameter names are unique.

elna.cabal

@@ -33,6 +33,7 @@ library elna-internal
         Language.Elna.NameAnalysis
         Language.Elna.Parser
         Language.Elna.SymbolTable
+        Language.Elna.TypeAnalysis
         Language.Elna.Types
     build-depends:
         exceptions ^>= 0.10,

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

lib/Language/Elna/TypeAnalysis.hs

@@ -0,0 +1,39 @@
+module Language.Elna.TypeAnalysis
+    ( Error(..)
+    , typeAnalysis
+    ) where
+
+import Control.Monad.Trans.Except (Except, runExcept)
+import Control.Monad.Trans.Reader (ReaderT, runReaderT)
+import qualified Language.Elna.AST as AST
+import Language.Elna.SymbolTable (SymbolTable)
+
+data Error = Error
+    deriving (Eq, Show)
+
+newtype TypeAnalysis a = TypeAnalysis
+    { runTypeAnalysis :: ReaderT SymbolTable (Except Error) a
+    }
+
+instance Functor TypeAnalysis
+  where
+    fmap f (TypeAnalysis x) = TypeAnalysis $ f <$> x
+
+instance Applicative TypeAnalysis
+  where
+    pure = TypeAnalysis . pure
+    (TypeAnalysis f) <*> (TypeAnalysis x) = TypeAnalysis $ f <*> x
+
+instance Monad TypeAnalysis
+  where
+    (TypeAnalysis x) >>= f = TypeAnalysis $ x >>= (runTypeAnalysis . f)
+
+typeAnalysis :: SymbolTable -> AST.Program -> Maybe Error
+typeAnalysis globalTable = either Just (const Nothing)
+    . runExcept
+    . flip runReaderT globalTable
+    . runTypeAnalysis
+    . program
+
+program :: AST.Program -> TypeAnalysis ()
+program (AST.Program _declarations) = pure ()