diff options
Diffstat (limited to 'lib/Language/Elna/NameAnalysis.hs')
| -rw-r--r-- | lib/Language/Elna/NameAnalysis.hs | 30 |
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) |
