Don't allow identifier duplicates

2 files changed, 49 insertions, 14 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)
diff --git a/lib/Language/Elna/SymbolTable.hs b/lib/Language/Elna/SymbolTable.hs
index b8892c9..eb82073 100644
--- a/lib/Language/Elna/SymbolTable.hs
+++ b/lib/Language/Elna/SymbolTable.hs
@@ -2,15 +2,19 @@ module Language.Elna.SymbolTable
     ( Info(..)
     , ParameterInfo(..)
     , SymbolTable
+    , builtInSymbolTable
     , empty
     , enter
     , fromList
     , lookup
-    , builtInSymbolTable
+    , member
     ) where
 
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
+import Data.List (sort)
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as NonEmpty
 import Data.Vector (Vector)
 import Language.Elna.Location (Identifier(..))
 import Language.Elna.Types (Type(..), intType, booleanType)
@@ -25,7 +29,7 @@ instance Semigroup SymbolTable
 
 instance Monoid SymbolTable
   where
-    mempty = SymbolTable HashMap.empty
+    mempty = empty
 
 builtInSymbolTable :: SymbolTable
 builtInSymbolTable = SymbolTable $ HashMap.fromList
@@ -36,15 +40,30 @@ builtInSymbolTable = SymbolTable $ HashMap.fromList
 empty :: SymbolTable
 empty = SymbolTable HashMap.empty
 
-enter :: Identifier -> Info -> SymbolTable -> SymbolTable
-enter identifier info (SymbolTable table) = SymbolTable
-    $ HashMap.insert identifier info table
+enter :: Identifier -> Info -> SymbolTable -> Maybe SymbolTable
+enter identifier info table@(SymbolTable hashTable)
+    | member identifier table = Nothing
+    | otherwise = Just
+        $ SymbolTable
+        $ HashMap.insert identifier info hashTable
 
 lookup :: Identifier -> SymbolTable -> Maybe Info
 lookup identifier (SymbolTable table) = HashMap.lookup identifier table
 
-fromList :: [(Identifier, Info)] -> SymbolTable
-fromList = SymbolTable . HashMap.fromList
+member :: Identifier -> SymbolTable -> Bool
+member identifier (SymbolTable table) = HashMap.member identifier table
+
+fromList :: [(Identifier, Info)] -> Either (NonEmpty Identifier) SymbolTable
+fromList elements
+    | Just identifierDuplicates' <- identifierDuplicates =
+        Left identifierDuplicates'
+    | otherwise = Right $ SymbolTable $ HashMap.fromList elements
+  where
+    identifierDuplicates = NonEmpty.nonEmpty
+        $ fmap NonEmpty.head
+        $ filter ((> 1) . NonEmpty.length)
+        $ NonEmpty.group . sort
+        $ fst <$> elements
 
 data ParameterInfo = ParameterInfo
     { name :: Identifier