Add typeExpression to type converter

1 files changed, 63 insertions, 1 deletions

diff --git a/lib/Language/Elna/NameAnalysis.hs b/lib/Language/Elna/NameAnalysis.hs
index 7388851..abbfb93 100644
--- a/lib/Language/Elna/NameAnalysis.hs
+++ b/lib/Language/Elna/NameAnalysis.hs
@@ -1,3 +1,65 @@
 module Language.Elna.NameAnalysis
-    (
+    ( Error(..)
+    , nameAnalysis
     ) where
+
+import Control.Monad.Trans.Except (ExceptT(..), runExceptT, throwE)
+import Control.Monad.Trans.Reader (Reader, ask, runReader)
+import Data.Functor ((<&>))
+import qualified Language.Elna.AST as AST
+import Language.Elna.Location (Identifier(..))
+import Language.Elna.SymbolTable (Info(..), SymbolTable, symbolTable)
+import qualified Language.Elna.SymbolTable as SymbolTable
+import Language.Elna.Types (Type(..))
+import Control.Monad.Trans.Class (MonadTrans(..))
+
+data Error
+    = UndefinedTypeError Identifier
+    | UnexpectedTypeInfoError Info
+    deriving (Eq, Show)
+
+newtype NameAnalysis a = NameAnalysis
+    { runNameAnalysis :: ExceptT Error (Reader SymbolTable) a
+    }
+
+instance Functor NameAnalysis
+  where
+    fmap f (NameAnalysis x) = NameAnalysis $ f <$> x
+
+instance Applicative NameAnalysis
+  where
+    pure x = NameAnalysis $ pure x
+    (NameAnalysis f) <*> (NameAnalysis x) = NameAnalysis $ f <*> x
+
+instance Monad NameAnalysis
+  where
+    (NameAnalysis x) >>= f = NameAnalysis $ x >>= (runNameAnalysis . f)
+
+nameAnalysis :: AST.Program -> Either Error SymbolTable
+nameAnalysis = flip runReader symbolTable
+    . runExceptT
+    . runNameAnalysis
+    . program
+
+program :: AST.Program -> NameAnalysis SymbolTable
+program (AST.Program declarations) = do
+    globalDeclarations <- traverse declaration declarations
+    NameAnalysis $ lift ask
+
+declaration :: AST.Declaration -> NameAnalysis (Identifier, Info)
+declaration (AST.TypeDefinition identifier typeExpression) =
+    (identifier,) . TypeInfo <$> dataType typeExpression
+declaration (AST.ProcedureDefinition identifier _parameters _variables _body) = do
+    environmentSymbolTable <- NameAnalysis $ lift ask
+    pure (identifier, ProcedureInfo environmentSymbolTable mempty)
+
+dataType :: AST.TypeExpression -> NameAnalysis Type
+dataType (AST.NamedType baseType) = do
+    environmentSymbolTable <- NameAnalysis $ lift ask
+    case SymbolTable.lookup baseType environmentSymbolTable of
+        Just baseInfo
+            | TypeInfo baseType' <- baseInfo -> pure baseType'
+            | otherwise -> NameAnalysis $ throwE $ UnexpectedTypeInfoError baseInfo
+        _ -> NameAnalysis $ throwE $ UndefinedTypeError baseType
+dataType (AST.ArrayType arraySize baseType) =
+    dataType baseType <&> ArrayType arraySize