Add typeExpression to type converter

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

lib/Language/Elna/SymbolTable.hs

@@ -1,37 +1,43 @@
 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)
-
-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"
+import Language.Elna.Location (Identifier(..))
+import Language.Elna.Types (Type(..), intType, booleanType)
+import Prelude hiding (lookup)
 
 newtype SymbolTable = SymbolTable (HashMap Identifier Info)
     deriving (Eq, Show)
 
+instance Semigroup SymbolTable
+  where
+    (SymbolTable lhs) <> (SymbolTable rhs) = SymbolTable $ rhs <> lhs
+
+instance Monoid SymbolTable
+  where
+    mempty = SymbolTable HashMap.empty
+
+symbolTable :: SymbolTable
+symbolTable = SymbolTable $ HashMap.fromList
+    [ ("boolean", TypeInfo booleanType)
+    , ("int", TypeInfo intType)
+    ]
+
+enter :: Identifier -> Info -> SymbolTable -> SymbolTable
+enter identifier info (SymbolTable table) = SymbolTable
+    $ HashMap.insert identifier info table
+
+lookup :: Identifier -> SymbolTable -> Maybe Info
+lookup identifier (SymbolTable table) = HashMap.lookup identifier table
+
 data ParameterInfo = ParameterInfo
     { name :: Identifier
     , type' :: Type

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"