Parse type declarations

lib/Language/Elna/Frontend/AST.hs

@@ -28,13 +28,13 @@ instance Show Program
 
 data Declaration
     = ProcedureDeclaration Identifier [Parameter] [VariableDeclaration] [Statement]
-    -- | TypeDefinition Identifier TypeExpression
+    | TypeDefinition Identifier TypeExpression
     deriving Eq
 
 instance Show Declaration
   where
-    {- show (TypeDefinition identifier typeExpression) =
+    show (TypeDefinition identifier typeExpression) =
-        concat ["type ", show identifier, " = ", show typeExpression, ";"] -}
+        concat ["type ", show identifier, " = ", show typeExpression, ";"]
     show (ProcedureDeclaration procedureName parameters variables body)
         = "proc " <> show procedureName <> showParameters parameters <> " {\n"
         <> unlines (("  " <>) . show <$> variables)

lib/Language/Elna/Frontend/NameAnalysis.hs

@@ -71,12 +71,19 @@ program symbolTable (AST.Program declarations) = do
     foldM declaration globalTable declarations
 
 procedureDeclaration :: SymbolTable -> AST.Declaration -> NameAnalysis SymbolTable
-procedureDeclaration globalTable (AST.ProcedureDeclaration identifier parameters _ _) = do
+procedureDeclaration globalTable = \case
-    parametersInfo <- mapM (parameter globalTable) parameters
+    (AST.ProcedureDeclaration identifier parameters _ _)
-    let procedureInfo = ProcedureInfo SymbolTable.empty
+        -> mapM (parameter globalTable) parameters
-            $ Vector.fromList parametersInfo
+        >>= enterOrFail identifier
-    maybe (NameAnalysis $ throwE $ IdentifierAlreadyDefinedError identifier) pure
+        . ProcedureInfo SymbolTable.empty
-        $ SymbolTable.enter identifier procedureInfo globalTable
+        . Vector.fromList
+    (AST.TypeDefinition identifier typeExpression)
+        -> dataType globalTable typeExpression
+        >>= enterOrFail identifier . SymbolTable.TypeInfo
+  where
+    enterOrFail identifier declarationInfo =
+        maybe (NameAnalysis $ throwE $ IdentifierAlreadyDefinedError identifier) pure
+            $ SymbolTable.enter identifier declarationInfo globalTable
 
 declaration :: SymbolTable -> AST.Declaration -> NameAnalysis SymbolTable
 declaration globalTable (AST.ProcedureDeclaration identifier parameters variables body) = do
@@ -92,6 +99,7 @@ declaration globalTable (AST.ProcedureDeclaration identifier parameters variable
     updater procedureTable (ProcedureInfo _ parameters') = Just
         $ ProcedureInfo procedureTable parameters'
     updater _ _ = Nothing
+declaration globalTable (AST.TypeDefinition _ _) = pure globalTable
 
 parameterToVariableInfo :: SymbolTable -> AST.Parameter -> NameAnalysis (Identifier, Info)
 parameterToVariableInfo symbolTable (AST.Parameter identifier typeExpression isReferenceParameter')

lib/Language/Elna/Frontend/Parser.hs

@@ -52,14 +52,14 @@ literalP
   where
     charP = fromIntegral . fromEnum
         <$> between (char '\'') (char '\'') Lexer.charLiteral
-{-
+
 typeDefinitionP :: Parser Declaration
 typeDefinitionP = TypeDefinition
     <$> (symbol "type" *> identifierP)
     <*> (symbol "=" *> typeExpressionP)
     <* semicolonP
     <?> "type definition"
--}
+
 termP :: Parser Expression
 termP = choice
     [ parensP expressionP
@@ -214,7 +214,7 @@ variableDeclarationP = VariableDeclaration
     <?> "variable declaration"
 
 declarationP :: Parser Declaration
-declarationP = procedureDeclarationP -- <|> typeDefinitionP
+declarationP = procedureDeclarationP <|> typeDefinitionP
 
 programP :: Parser Program
 programP = Program <$> many declarationP <* eof

lib/Language/Elna/Glue.hs

@@ -70,7 +70,7 @@ declaration globalTable (AST.ProcedureDeclaration procedureName _ _ statements)
     . flip Vector.snoc StopQuadruple
     . fold
     <$> traverse (statement globalTable) statements
--- declaration (AST.TypeDefinition _ _) accumulator = pure accumulator
+declaration _ (AST.TypeDefinition _ _) = pure Nothing
 
 statement :: SymbolTable -> AST.Statement -> Glue (Vector (Quadruple Variable))
 statement _ AST.EmptyStatement = pure mempty