Add typeExpression to type converter

TODO

@@ -1,4 +1,9 @@
-# AST missing
+# Name analysis
 
-- Import
-- Record and Union initialization
+- Collect all global type and procedure definitions.
+  Give errors if:
+  - The type is already defined.
+  - Base type is not defined.
+  - Circular type reference.
+
+- Check definitions inside procedures.

elna.cabal

@@ -1,4 +1,4 @@
-cabal-version:      3.0
+cabal-version: 3.4
 name: elna
 version: 0.1.0.0
 synopsis:
@@ -16,13 +16,14 @@ extra-doc-files: TODO README
 
 common warnings
     build-depends:
-        base ^>=4.17.2.1,
+        base >=4.7 && <5,
         megaparsec ^>= 9.6,
         text ^>= 2.0
     ghc-options: -Wall
     default-extensions:
         ExplicitForAll,
         OverloadedStrings
+    default-language: GHC2021
 
 library elna-internal
     import: warnings
@@ -32,9 +33,11 @@ library elna-internal
         Language.Elna.NameAnalysis
         Language.Elna.Parser
         Language.Elna.SymbolTable
+        Language.Elna.Types
     build-depends:
         hashable ^>= 1.4.3,
         parser-combinators ^>= 1.3,
+        transformers ^>= 0.6.1,
         vector ^>= 0.13.1,
         unordered-containers ^>= 0.2.20
     hs-source-dirs: lib
@@ -43,9 +46,8 @@ executable elna
     import: warnings
     main-is: Main.hs
     build-depends:
-        elna-internal
+        elna:elna-internal
     hs-source-dirs: src
-    default-language: GHC2021
 
 test-suite elna-test
     import: warnings
@@ -58,11 +60,10 @@ test-suite elna-test
     ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
 
     build-depends:
-        elna-internal,
+        elna:elna-internal,
         hspec >= 2.10.9 && < 2.12,
         hspec-expectations ^>= 0.8.2,
         hspec-megaparsec ^>= 2.2.0,
         text
     build-tool-depends:
         hspec-discover:hspec-discover
-    default-language: GHC2021

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"