From 92990e52f017c3fa0b9ff99f517171051d8c7c18 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Mon, 29 Jul 2024 08:26:47 +0300
Subject: Add typeExpression to type converter

---
 lib/Language/Elna/NameAnalysis.hs | 64 ++++++++++++++++++++++++++++++++++++++-
 lib/Language/Elna/SymbolTable.hs  | 46 ++++++++++++++++------------
 lib/Language/Elna/Types.hs        | 25 +++++++++++++++
 3 files changed, 114 insertions(+), 21 deletions(-)
 create mode 100644 lib/Language/Elna/Types.hs

(limited to 'lib/Language')

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
diff --git a/lib/Language/Elna/SymbolTable.hs b/lib/Language/Elna/SymbolTable.hs
index a33df44..ba2e41f 100644
--- a/lib/Language/Elna/SymbolTable.hs
+++ b/lib/Language/Elna/SymbolTable.hs
@@ -1,36 +1,42 @@
 module Language.Elna.SymbolTable
     ( Info(..)
     , ParameterInfo(..)
-    , SymbolTable(..)
-    , Type(..)
-    , booleanType
-    , intType
+    , SymbolTable
+    , enter
+    , lookup
+    , symbolTable
     ) where
 
 import Data.HashMap.Strict (HashMap)
-import Data.Text (Text)
+import qualified Data.HashMap.Strict as HashMap
 import Data.Vector (Vector)
-import Data.Word (Word32)
-import Language.Elna.Location (Identifier(..), showArrayType)
+import Language.Elna.Location (Identifier(..))
+import Language.Elna.Types (Type(..), intType, booleanType)
+import Prelude hiding (lookup)
 
-data Type
-    = PrimitiveType Text
-    | ArrayType Word32 Type
-    deriving Eq
+newtype SymbolTable = SymbolTable (HashMap Identifier Info)
+    deriving (Eq, Show)
+
+instance Semigroup SymbolTable
+  where
+    (SymbolTable lhs) <> (SymbolTable rhs) = SymbolTable $ rhs <> lhs
 
-instance Show Type
+instance Monoid SymbolTable
   where
-    show (PrimitiveType typeName) = show typeName
-    show (ArrayType elementCount typeName) = showArrayType elementCount typeName
+    mempty = SymbolTable HashMap.empty
 
-intType :: Type
-intType = PrimitiveType "int"
+symbolTable :: SymbolTable
+symbolTable = SymbolTable $ HashMap.fromList
+    [ ("boolean", TypeInfo booleanType)
+    , ("int", TypeInfo intType)
+    ]
 
-booleanType :: Type
-booleanType = PrimitiveType "boolean"
+enter :: Identifier -> Info -> SymbolTable -> SymbolTable
+enter identifier info (SymbolTable table) = SymbolTable
+    $ HashMap.insert identifier info table
 
-newtype SymbolTable = SymbolTable (HashMap Identifier Info)
-    deriving (Eq, Show)
+lookup :: Identifier -> SymbolTable -> Maybe Info
+lookup identifier (SymbolTable table) = HashMap.lookup identifier table
 
 data ParameterInfo = ParameterInfo
     { name :: Identifier
diff --git a/lib/Language/Elna/Types.hs b/lib/Language/Elna/Types.hs
new file mode 100644
index 0000000..80a88c0
--- /dev/null
+++ b/lib/Language/Elna/Types.hs
@@ -0,0 +1,25 @@
+module Language.Elna.Types
+    ( Type(..)
+    , booleanType
+    , intType
+    ) where
+
+import Data.Text (Text)
+import Data.Word (Word32)
+import Language.Elna.Location (showArrayType)
+
+data Type
+    = PrimitiveType Text
+    | ArrayType Word32 Type
+    deriving Eq
+
+instance Show Type
+  where
+    show (PrimitiveType typeName) = show typeName
+    show (ArrayType elementCount typeName) = showArrayType elementCount typeName
+
+intType :: Type
+intType = PrimitiveType "int"
+
+booleanType :: Type
+booleanType = PrimitiveType "boolean"
-- 
cgit v1.2.3