Don't allow identifier duplicates

1 files changed, 23 insertions, 7 deletions

diff --git a/lib/Language/Elna/NameAnalysis.hs b/lib/Language/Elna/NameAnalysis.hs
index bd1b854..afb040e 100644
--- a/lib/Language/Elna/NameAnalysis.hs
+++ b/lib/Language/Elna/NameAnalysis.hs
@@ -13,10 +13,12 @@ import qualified Language.Elna.SymbolTable as SymbolTable
 import Language.Elna.Types (Type(..))
 import Control.Monad.Trans.Class (MonadTrans(..))
 import Control.Monad (foldM)
+import qualified Data.List.NonEmpty as NonEmpty
 
 data Error
     = UndefinedTypeError Identifier
     | UnexpectedTypeInfoError Info
+    | IdentifierAlreadyDefinedError Identifier
     deriving (Eq, Show)
 
 newtype NameAnalysis a = NameAnalysis
@@ -29,7 +31,7 @@ instance Functor NameAnalysis
 
 instance Applicative NameAnalysis
   where
-    pure x = NameAnalysis $ pure x
+    pure = NameAnalysis . pure
     (NameAnalysis f) <*> (NameAnalysis x) = NameAnalysis $ f <*> x
 
 instance Monad NameAnalysis
@@ -49,13 +51,27 @@ program (AST.Program declarations)
 
 declaration :: SymbolTable -> AST.Declaration -> NameAnalysis SymbolTable
 declaration globalTable (AST.TypeDefinition identifier typeExpression)
-    = flip (SymbolTable.enter identifier) globalTable . TypeInfo
-    <$> withSymbolTable globalTable (dataType typeExpression)
+    = withSymbolTable globalTable (dataType typeExpression)
+    >>= flip (enter identifier) globalTable . TypeInfo
+    
 declaration globalTable (AST.ProcedureDefinition identifier parameters variables _body) = do
-    parametersInfo <- mapM parameter parameters
-    variableInfo <- mapM variableDeclaration variables
-    let localTable = SymbolTable.fromList $ parametersInfo <> variableInfo
-    pure $ SymbolTable.enter identifier (ProcedureInfo localTable mempty) globalTable
+        parametersInfo <- mapM parameter parameters
+        variableInfo <- mapM variableDeclaration variables
+        newTable <- either (identifierAlreadyDefinedError . NonEmpty.head) pure
+            $ SymbolTable.fromList
+            $ parametersInfo <> variableInfo
+        enter identifier (ProcedureInfo newTable mempty) globalTable
+
+enter :: Identifier -> Info -> SymbolTable -> NameAnalysis SymbolTable
+enter identifier info table
+    = maybe (identifierAlreadyDefinedError identifier) pure
+    $ SymbolTable.enter identifier info table
+
+identifierAlreadyDefinedError :: Identifier -> NameAnalysis a
+identifierAlreadyDefinedError = NameAnalysis
+    . lift
+    . throwE
+    . IdentifierAlreadyDefinedError
 
 variableDeclaration :: AST.VariableDeclaration -> NameAnalysis (Identifier, Info)
 variableDeclaration (AST.VariableDeclaration identifier typeExpression)