From a1863147f866718c19c8fdefeeb033efab766885 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Mon, 5 Aug 2024 22:56:35 +0200 Subject: [PATCH] Don't allow identifier duplicates --- TODO | 1 - lib/Language/Elna/NameAnalysis.hs | 30 ++++++++++++++++------ lib/Language/Elna/SymbolTable.hs | 33 +++++++++++++++++++------ tests/Language/Elna/NameAnalysisSpec.hs | 4 +-- 4 files changed, 51 insertions(+), 17 deletions(-) diff --git a/TODO b/TODO index b88eefb..775114d 100644 --- a/TODO +++ b/TODO @@ -1,4 +1,3 @@ # Name analysis - Ensure type, procedure, variable and parameter names are unique. -- Check symbols used in procedures are defined. 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 diff --git a/tests/Language/Elna/NameAnalysisSpec.hs b/tests/Language/Elna/NameAnalysisSpec.hs index 9d63e74..c6f4504 100644 --- a/tests/Language/Elna/NameAnalysisSpec.hs +++ b/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"