Don't allow identifier duplicates

TODO

@@ -1,4 +1,3 @@
 # Name analysis
 
 - Ensure type, procedure, variable and parameter names are unique.
-- Check symbols used in procedures are defined.

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
+        parametersInfo <- mapM parameter parameters
-    variableInfo <- mapM variableDeclaration variables
+        variableInfo <- mapM variableDeclaration variables
-    let localTable = SymbolTable.fromList $ parametersInfo <> variableInfo
+        newTable <- either (identifierAlreadyDefinedError . NonEmpty.head) pure
-    pure $ SymbolTable.enter identifier (ProcedureInfo localTable mempty) globalTable
+            $ 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)

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 -> Maybe SymbolTable
-enter identifier info (SymbolTable table) = SymbolTable
+enter identifier info table@(SymbolTable hashTable)
-    $ HashMap.insert identifier info table
+    | 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
+member :: Identifier -> SymbolTable -> Bool
-fromList = SymbolTable . HashMap.fromList
+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

tests/Language/Elna/NameAnalysisSpec.hs

@@ -63,7 +63,7 @@ spec = describe "nameAnalysis" $ do
         case SymbolTable.lookup "main" <$> actual of
             Right lookupResult
                 | Just (ProcedureInfo localTable _) <- lookupResult ->
-                    localTable `shouldBe` expected
+                    Just localTable `shouldBe` expected
             _ -> expectationFailure "Procedure symbol not found"
 
     it "puts variables into the local symbol table" $ do
@@ -74,5 +74,5 @@ spec = describe "nameAnalysis" $ do
         case SymbolTable.lookup "main" <$> actual of
             Right lookupResult
                 | Just (ProcedureInfo localTable _) <- lookupResult ->
-                    localTable `shouldBe` expected
+                    Just localTable `shouldBe` expected
             _ -> expectationFailure "Procedure symbol not found"